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 = frmMain.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, 10, 10, x, y, _ frmMain.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