Local oForm oForm = Createobject("Tform") oForm.Show(1) * end of main Define Class Tform As Form #Define WM_CAP_START 0x0400 #Define WM_CAP_DRIVER_CONNECT (WM_CAP_START+10) #Define WM_CAP_DRIVER_DISCONNECT (WM_CAP_START+11) #Define WM_CAP_DRIVER_GET_CAPS (WM_CAP_START+14) #Define WM_CAP_SET_PREVIEW (WM_CAP_START+50) #Define WM_CAP_SET_OVERLAY (WM_CAP_START+51) #Define WM_CAP_SET_PREVIEWRATE (WM_CAP_START+52) #Define WM_CAP_GET_STATUS (WM_CAP_START+54) #Define WM_CAP_GRAB_FRAME (WM_CAP_START+60) Width=340 Height=310 AutoCenter=.T. Caption="Using Video Capture" MinButton=.F. MaxButton=.F. ShowWindow=1 WindowType=1 hWindow=0 hCapture=0 capWidth=0 capHeight=0 capOverlay=0 Add Object cmdGetFrame As CommandButton With ; Left=15, Top=264, Height=27, Width=90, Caption="Take Photo",; Enabled=.F. Add Object cmdPreview As CommandButton With Default=.T.,; Left=106, Top=264, Height=27, Width=100, Caption="Preview Video",; Enabled=.F. Add Object cmdClose As CommandButton With Cancel=.T.,; Left=207, Top=264, Height=27, Width=70, Caption="Close" Procedure Activate If This.hWindow = 0 Declare Integer GetFocus In user32 This.hWindow = GetFocus() This.CreateCaptureWindow This.DriverConnect This.cmdPreview.Click Endif Procedure Destroy This.ReleaseCaptureWindow Procedure cmdClose.Click Thisform.Release Procedure cmdGetFrame.Click Thisform.GetFrame Procedure cmdPreview.Click Thisform.StartPreview Procedure GetFrame #Define WM_CAP_FILE_SAVEDIB (WM_CAP_START + 25) Local lcFile lcFile = "c:\temp\sample.bmp" This.msg(WM_CAP_GRAB_FRAME, 0,0) This.msg(WM_CAP_FILE_SAVEDIB, 0, lcFile,1) Procedure CreateCaptureWindow #Define WS_CHILD 0x40000000 #Define WS_VISIBLE 0x10000000 Declare Integer capCreateCaptureWindow In avicap32; STRING lpszWindowName, Long dwStyle,; INTEGER x, Integer Y,; INTEGER nWidth, Integer nHeight,; INTEGER hParent, Integer nID This.hCapture = capCreateCaptureWindow("",; WS_CHILD+WS_VISIBLE,; 10,8,320,240, This.hWindow, 1) *********************************** *WAIT a while Declare Integer GetTickCount In WIN32API IniTime = GetTickCount() Do While GetTickCount() < (IniTime + 2000) DoEvents Enddo ******************************************* Procedure DriverConnect This.msg(WM_CAP_DRIVER_CONNECT, 0,0) If This.IsCaptureConnected() This.GetCaptureDimensions Store .T. To This.cmdGetFrame.Enabled,; This.cmdPreview.Enabled This.Caption = This.Caption + ": connected, " +; LTRIM(Str(This.capWidth)) + "x" +; LTRIM(Str(This.capHeight)) Else This.Caption = This.Caption + ": failed to connect" Endif Procedure DriverDisconnect This.msg(WM_CAP_DRIVER_DISCONNECT, 0,0) Procedure ReleaseCaptureWindow If This.hCapture <> 0 This.DriverDisconnect Declare Integer DestroyWindow In user32 Integer HWnd = DestroyWindow(This.hCapture) This.hCapture = 0 Endif Procedure msg(msg, wParam, Lparam, nMode) If This.hCapture = 0 Return Endif If Vartype(nMode) <> "N" Or nMode=0 Declare Integer SendMessage In user32; INTEGER HWnd, Integer Msg,; INTEGER wParam, Integer Lparam = SendMessage(This.hCapture, msg, wParam, Lparam) Else Declare Integer SendMessage In user32; INTEGER HWnd, Integer Msg,; INTEGER wParam, String @Lparam = SendMessage(This.hCapture, msg, wParam, @Lparam) Endif Function IsCaptureConnected * analyzing fCaptureInitialized member of the CAPDRIVERCAPS structure #Define CAPDRIVERCAPS_SIZE 44 Local cBuffer, nResult cBuffer = Repli(Chr(0),CAPDRIVERCAPS_SIZE) This.msg(WM_CAP_DRIVER_GET_CAPS, Len(cBuffer), @cBuffer, 1) This.capOverlay = buf2dword(Substr(cBuffer,5,4)) nResult = Asc(Substr(cBuffer, 21,1)) Return (nResult<>0) Procedure GetCaptureDimensions * reading uiImageWidth and uiImageHeight members * of the CAPSTATUS structure #Define CAPSTATUS_SIZE 76 Local cBuffer cBuffer = Repli(Chr(0), CAPSTATUS_SIZE) This.msg(WM_CAP_GET_STATUS, Len(cBuffer), @cBuffer, 1) This.capWidth = buf2dword(Substr(cBuffer,1,4)) This.capHeight = buf2dword(Substr(cBuffer,5,4)) Procedure StartPreview This.msg(WM_CAP_SET_PREVIEWRATE, 30,0) This.msg(WM_CAP_SET_PREVIEW, 1,0) If This.capOverlay <> 0 This.msg(WM_CAP_SET_OVERLAY, 1,0) Endif Procedure StopPreview This.msg(WM_CAP_SET_PREVIEW, 0,0) Enddefine Function buf2dword(lcBuffer) Return Asc(Substr(lcBuffer, 1,1)) + ; BitLShift(Asc(Substr(lcBuffer, 2,1)), 8) +; BitLShift(Asc(Substr(lcBuffer, 3,1)), 16) +; BitLShift(Asc(Substr(lcBuffer, 4,1)), 24)