Attribute VB_Name = "MemCap"
'*
'* Author: E. J. Bantz Jr.
'* Copyright: None, use and distribute freely ...
'* E-Mail: ejbantz@usa.net
'* Web: http://www.inlink.com/~ejbantz

'// ------------------------------------------------------------------
'//  Windows API Constants / Types / Declarations
'// ------------------------------------------------------------------

Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const HWND_BOTTOM = 1

'// Memory manipulation
Declare Function lStrCpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Declare Function lStrCpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As Any, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Declare Sub RtlMoveMemory Lib "kernel32" (ByVal hpvDest As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub hmemcpy Lib "kernel32" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    
'// Window manipulation
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean







Function MyFrameCallback(ByVal lwnd As Long, ByVal lpVHdr As Long) As Long
'**************************************************************************
'*MyFrameCallBack: Modified by Mike
'*Function modified to only preform functions if they are asked for by the
'*main window.  Initialization of data and function calls to my procedures
'*also added
'*
'*This function is the key piece to using the general camera driver.
'*THis function gets called every time a frame from the video stream set up
'*in the main frame recieves a frame of video data.
'*Input: lWind:  pointer to window videostream is atached to
'*       lpVhdr: Pointer to video frame header structure
'***************************************************************************
        
   MyFrameCallback = Form1.FrameCallback(lwnd, lpVHdr)

End Function






Sub MyInitVideoStream(lwndC As Long, lpszName As String, _
       lpszVer As String, x As Long, y As Long, _
       PrevRate As Long, doPrevew As Boolean)

    '*All functions starting with "cap" are wrappers for messages.  The message sent can be found
    '*in AVICAP

    '//Create Capture Window
    capGetDriverDescriptionA 0, lpszName, 100, lpszVer, 100  '// Retrieves driver info
    lwndC = capCreateCaptureWindowA(lpszName, _
              WS_CHILD Or WS_VISIBLE, 0, 0, x, y, _
              Form1.hwnd, 0)

    '// Connect the capture window to the driver
    capDriverConnect lwndC, 0
    
    '// Get the capabilities of the capture driver
    capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)
    
    '// If the capture driver does not support a dialog, grey it out
    '// in the menu bar.
   ' If Caps.fHasDlgVideoFormat = 0 Then mnuFormat.Enabled = False
    
    '// Set the video stream callback function
    capSetCallbackOnVideoStream lwndC, AddressOf MyVideoStreamCallback
    '      *Important: Telling stream where to find our frame handling code
    Call capSetCallbackOnFrame(lwndC, AddressOf MyFrameCallback)
    
    '// Set the preview rate in milliseconds
    capPreviewRate lwndC, PrevRate
    
    '// Start previewing the image from the camera
    capPreview lwndC, doPrevew
        
    '// Resize the capture window to show the whole image
    ResizeCaptureWindow lwndC
    
End Sub

Sub MyDestructVideoStream(lwndC As Long)
    '*Set all callbacks to null
    capSetCallbackOnError lwndC, vbNull
    capSetCallbackOnStatus lwndC, vbNull
    capSetCallbackOnYield lwndC, vbNull
    capSetCallbackOnFrame lwndC, vbNull
    capSetCallbackOnVideoStream lwndC, vbNull
    capSetCallbackOnWaveStream lwndC, vbNull
    capSetCallbackOnCapControl lwndC, vbNull
    
End Sub

Function MyYieldCallback(lwnd As Long) As Long

'    Debug.Print "Yield"

End Function

Function MyErrorCallback(ByVal lwnd As Long, ByVal iID As Long, ByVal ipstrStatusText As Long) As Long
    
    If iID = 0 Then Exit Function
    
    Dim sStatusText As String
    Dim usStatusText As String
    
    'Convert the Pointer to a real VB String
    sStatusText = String$(255, 0)                                      '// Make room for message
    lStrCpy StrPtr(sStatusText), ipstrStatusText                       '// Copy message into String
    sStatusText = Left$(sStatusText, InStr(sStatusText, Chr$(0)) - 1)  '// Only look at left of null
    usStatusText = StrConv(sStatusText, vbUnicode)                     '// Convert Unicode
            
    Debug.Print "Error: ", usStatusText, iID

End Function

Function MyStatusCallback(ByVal lwnd As Long, ByVal iID As Long, ByVal ipstrStatusText As Long) As Long

    If iID = 0 Then Exit Function
   
    Dim sStatusText As String
    Dim usStatusText As String
    
    '// Convert the Pointer to a real VB String
    sStatusText = String$(255, 0)                                      '// Make room for message
    lStrCpy StrPtr(sStatusText), ipstrStatusText                       '// Copy message into String
    sStatusText = Left$(sStatusText, InStr(sStatusText, Chr$(0)) - 1)  '// Only look at left of null
    usStatusText = StrConv(sStatusText, vbUnicode)                     '// Convert Unicode
    
    Debug.Print "Status: ", usStatusText, iID
    Form1.List1.AddItem "Status " & usStatusText & "  " & iID

End Function

Function MyVideoStreamCallback(lwnd As Long, lpVHdr As Long) As Long

    Beep  '// Replace this with your code!
    Form1.List1.AddItem "In MyVideoStreamCallback!!!"
  
End Function

Function MyWaveStreamCallback(lwnd As Long, lpVHdr As Long) As Long

    Debug.Print "WaveStream"
    Form1.List1.AddItem "In WaveStream Call Back"

End Function


Sub ResizeCaptureWindow(ByVal lwnd As Long)

    Dim CAPSTATUS As CAPSTATUS
    
    '// Get the capture window attributes .. width and height
    capGetStatus lwnd, VarPtr(CAPSTATUS), Len(CAPSTATUS)
        
    '// Resize the capture window to the capture sizes
    SetWindowPos lwnd, HWND_BOTTOM, 0, 0, _
                       CAPSTATUS.uiImageWidth, _
                       CAPSTATUS.uiImageHeight, _
                       SWP_NOMOVE Or SWP_NOZORDER
         
End Sub
