' WebCam.dll is a Dynamic Linked Library written by me, ' John White , for myself and ' any programming language that can utilize it. $OPTIMIZE ON $APPTYPE GUI $TYPECHECK ON $ESCAPECHARS ON $INCLUDE $INCLUDE CONST Hide=0 CONST Show=1 CONST OFF=0 CONST ON=1 CONST CREATE_PALETTE=1 CONST PALETTE_TO_WEBCAM=0 dim d as qdebug DIM form AS QFORM DIM B1 AS QBUTTON DIM B2 AS QBUTTON DIM B3 AS QBUTTON DIM B4 AS QBUTTON DIM rtn AS LONG DIM stg$ AS STRING DIM sts AS BYTE sts=0 SUB CleanUp_Webcam IF sts=4 THEN WEBCAM_OverlayOFF IF sts=3 THEN WEBCAM_PreviewOFF IF sts>1 THEN WEBCAM_Disconnect IF sts>0 THEN WEBCAM_CloseWindow END SUB SUB BC1(Sender AS QBUTTON) 'Web Cam button IF sts THEN EXIT SUB 'been here before? Then don't run rtn=WEBCAM_OpenWindow(Form.Handle) ' Open Capture (Child) Window for WebCam IF rtn <> 1 THEN EXIT SUB sts=1 'set a status code rtn=WEBCAM_Connect 'Connect the WebCam Driver. IF rtn=1 THEN WEBCAM_GetCapabilities 'These next two calls MUST be called, WEBCAM_GetCaptureOptions 'otherwise the WebCam will not work properly rtn=WEBCAM_IsConnected 'Check if WebCam connected to its Driver. IF rtn=1 THEN sts=2 WEBCAM_SetPreviewRate(1) ' Check if the WebCam supports Overlay (Direct Hardware) mode or just the ' standard (cheap "Off the Market" WebCam!) software (CPU Expensive) mode. rtn=WEBCAM_CanItOverlay IF rtn=1 THEN WEBCAM_OverlayON sts=4 ELSE WEBCAM_PreviewON 'WEBCAM_PreviewScalingON sts=3 END IF END IF ELSE ShowMessage("WebCam could not Connect") END IF END SUB SUB BC2(Sender AS QBUTTON) 'Record button IF sts>1 THEN 'rtn=WEBCAM_GetInformation 'ShowMessage(VarPtr$(rtn)) 'ShowMessage(VarPtr$(rtn+100)) 'ShowMessage(VarPtr$(rtn+204)) 'ShowMessage(VarPtr$(rtn+304)) 'rtn=WEBCAM_GetConnectedName 'ShowMessage(VarPtr$(rtn)) 'rtn=WEBCAM_GetConnectedVersion 'ShowMessage(VarPtr$(rtn)) rtn=OPTION_SetOKMessage(Show) rtn=OPTION_SetCaptureTimer(ON,4) ' This method changes the name and size of the CAPTURE.AVI file. 'WEBCAM_SetCaptureFilename("C:\\Test.avi") 'WEBCAM_SetCaptureFilesize(1080000000) ' 1Gb = 1,080,000,000 ' This method changes the size of the CAPTURE.AVI file to 1Gb and then ' creates C:\Test.Avi so that C:\Test.Avi ends up containing only the ' actual video (i.e. a video of size 1.??Mb). WEBCAM_SetCaptureFilesize(1080000000) ' 1Gb = 1,080,000,000 WEBCAM_SetCaptureFilename("C:\\Test.avi") 'WEBCAM_SetSaveFilename("C:\\TestCopy.avi") WEBCAM_StartCapturing END IF END SUB SUB BC3(Sender AS QBUTTON) 'get info button DIM WebCInfo AS STRING $ESCAPECHARS ON WebCInfo = "" 'this is actually a STATIC WebCInfo = WebCInfo + STR$(WEBCAM_GetIDNumber) + "=ID# \n" WEBCAM_GetCaptureStatus WebCInfo = WebCInfo + STR$(STATUS_GetImageWidth) + "=ImageWidth \n" WebCInfo = WebCInfo + STR$(STATUS_GetImageHeight) + "=ImageHeight \n" WebCInfo = WebCInfo + STR$(STATUS_IsOverlayON) + "=OverlayON \n" WebCInfo = WebCInfo + STR$(STATUS_IsPreviewON) + "=PreviewON \n" WebCInfo = WebCInfo + STR$(STATUS_IsPreviewScalingON) + "=PreviewScalingON \n" WebCInfo = WebCInfo + STR$(STATUS_IsUsingDefaultPalette) + "=UsingDefaultPalette \n" WebCInfo = WebCInfo + STR$(STATUS_IsAudioInstalled) + "=AudioInstalled \n" 'WebCInfo = WebCInfo + STR$(STATUS_DoesCaptureFileExist 'WebCInfo = WebCInfo + STR$(STATUS_IsCapturingNow WEBCAM_StopCapturing DIALOG_VideoCompression DIALOG_VideoDisplay DIALOG_VideoFormat DIALOG_VideoSource END SUB SUB BC4(Sender AS QBUTTON) 'grab frame DIM i as integer DIM T as single DIM info AS TBITMAP dim rtn as long Dim hBitmap as long WEBCAM_PreviewScalingOFF WEBCAM_PreviewOFF ' T = TIMER ' for i = 1 to 100 FRAME_Grab 'slow, about7.5 hz FRAME_CopyToClipboard 'fast ' next i ' ShowMessage str$(TIMER - T) if clipboard.hasformat(CF_BITMAP) then clipboard.open hBitmap=clipboard.GetAsHandle(CF_BITMAP) clipboard.close else showmessage "not a valid format" end if D.SetError 0 'rtn = GetObject(Bitmap1.Handle,SIZEOF(info),info) rtn = GetObject(hBitmap,SIZEOF(info),info) D.Err$ D.Print rtn rtn = info.bmHeight D.Print(rtn) WEBCAM_PreviewON ' FRAME_CopyToDIB("C:\\TestDIB.bmp") ' Save with/out an extension (.jpg, etc) 'PALETTE_SaveAsFile("C:\\Test.PAL") 'PALETTE_ClipboardToWebcam 'PALETTE_ManualCreate(CREATE_PALETTE,256) 'PALETTE_ManualCreate(PALETTE_TO_WEBCAM,256) 'PALETTE_AutoCreate(1000,256) 'PALETTE_FileToWebcam("C:\\Test.PAL") END SUB Form.Width=700 Form.Height=550 Form.Center Form.Caption="WebCam DLL" Form.OnClose=CleanUp_WebCam B1.Parent=Form B1.Caption="WebCam" B1.Top=460 B1.Left=6 B1.Width=120 B1.Height=30 B1.OnClick=BC1 B2.Parent=Form B2.Caption="Get Info" B2.Top=460 B2.Left=146 B2.Width=120 B2.Height=30 B2.OnClick=BC3 B3.Parent=Form B3.Caption="Record" B3.Top=460 B3.Left=286 B3.Width=120 B3.Height=30 B3.OnClick=BC2 B4.Parent=Form B4.Caption="Grab Frame" B4.Top=460 B4.Left=420 B4.Width=120 B4.Height=30 B4.OnClick=BC4 Form.ShowModal