Documentation  by JohnK VFW

QWebCam  component (Video for windows  or VFW)

This is a custom component for video capture with video cameras, and USB web cams. For full documentation see vfw in windows software develoment. This component has only been tested with 24 bit graphics, and may not work in palette mode. Also see QAVI. .  See limitations.

Properties

Field Type R/W Default




CapStats  CAPSTATUS     (see msdn.microsoft.com) R
If you want to know the status of the capture you can use this UDT with the GetStatus Method

Dim MyCam AS QWebCam
MyCam.GetStatus
Showmessage "Scaling is :" + STR$(MyCam.CapStats.fScale)
CapParms  CAPTUREPARMS   (see msdn.microsoft.com) R
Parameters of the capture . Use this UDT with either GetParameters or SetParameters Methods

Dim MyCam AS QWebCam
MyCam.GetParameters(MyCam.CapParms)
Showmessage "Audio capture is :" + STR$(MyCam.CapParms.fCaptureAudio)
AudioBuffers  LONG               'Actual number of audio buffers R
AudioHardware  LONG               'hardware present? R
BitCount  WORD              'set color bit depth, 24, or 8 R/W 24
CamNum  LONG              'set in case more than one camera & driver, index 0 9 R
Caption  LONG              'window title in preview window R/W "video"
Capture  LONG              'sets capture On/Off R/W
Error  LONG             ' Error value after any operation R
FormStyle  LONG              'set formstyle of capture window  (default is WS_CHILD OR WS_VISIBLE) R
FrameBuffers  LONG              ''max number of requested frame buffers R 4
FrameNum  LONG               'Current frame captured R
FrameInterval  WORD             'Interval, in milliseconds, between captured frames RW 3333
FramesDropped  LONG R
hCapWnd  LONG              'our capture window handle  (not parent) R
Height  LONG R
ImageHeight  LONG RW
ImageWidth  LONG RW
Init LONG              'is the camera connected and working? RW 0
Left LONG RW 0
Top LONG RW 0
Right LONG RW
Overlay  LONG R/W False
Preview  LONG             'preview sets a window with real-time camera image  R/W True
ShowErrors INTEGER        ' If True error messages will appear in a message box automatically RW false
Tag  LONG             'the window ID returned from Windows when the capture window is created R
TimeElapsedMS  LONG             'Elapsed capture duration R  
Top  LONG R/W  
WaveSamples  LONG             ' number of wave samples captured  R  
Yield  LONG             'Capture via background task? R
Width  LONG R

QWebCam Methods
Method Type Description Params




CamInit FUNCTION (Form AS QFORM) AS LONG  Initialize and connect to camera 1
Form is a Qform that will show the preview screen
CleanUp SUB () 0
Call this before closing the form
GetParameters FUNCTION (MyParams AS CAPTUREPARMS) AS LONG   1
CAPTUREPARMS is a UDT defined in the include file and you can use QWebCam.CapParms
GetStatus FUNCTION () AS LONG   0
Call this if you want properties updated or want the QwebCam.CapStats updated 

Dim MyCam AS QWebCam
MyCam.GetStatus
Showmessage "X pixel in scan was  :" + STR$(MyCam.CapStats.ptScroll_x)
GrabFrameToClipBoard FUNCTION () AS LONG 0
The clipboard DIB contents will be overwritten
SaveFrameToFile FUNCTION (TheFileName AS STRING) AS Long 1
TheFileName should have a .bmp extension. Returns True if successful
SetImageSize FUNCTION (ImageWidth AS LONG, ImageHeight AS LONG) AS LONG 2
Returns True if successful
SetParameters FUNCTION (MyParams AS CAPTUREPARMS) AS LONG 1
Call this if you want properties updated or want the QwebCam.CapParms updated 

Dim MyCam AS QWebCam
MyCam.CapParms.vKeyAbort  = 27' Virtual key causing abort
MyCam.SetParameters(MyCam.CapParms)
ShowDialogBox FUNCTION (TheBoxNum) AS LONG 1
SUB ReSize(TheForm AS QFORM)
ReSize SUB (Form AS QFORM) 1
Do this after changing the ImageWidth or ImageHeight

QAVI Events
Event Type Occurs when... Params




OnFrame  CamFrameEvent(hCapWnd AS LONG, lpVHdr AS LONG)  2
Pass the Address of a SUB/Function with these parameters. The address is passed to Windows as a Callback for each frame captured. See the sample code for how it works.

QWebCam  Examples

'************************************************************************** 
'  Example Capture output and do pixel operations
'**************************************************************************
$TYPECHECK ON
$INCLUDE <RapidQ2.inc>
$INCLUDE <vfw.inc>

DECLARE SUB CamFrameEvent(hCapWnd AS LONG, lpVHdr AS LONG)
DECLARE SUB CleanUp_WebCam
DECLARE SUB FormKeyDown(Key AS Word, Shift AS INTEGER)
DECLARE SUB StartTheCamUp
DECLARE SUB ReSetImage
DECLARE SUB ResizeMyBMPs
DECLARE SUB SetMenuItem(Sender AS QMENUITEM)

CREATE CamForm AS QFORM
	BorderStyle = bsToolWindow
	Caption = "Camera output, Click to Start"
    Center
 	OnClose = CleanUp_WebCam
    OnClick = StartTheCamUp
    OnKeyDown = FormKeyDown
END CREATE


CREATE MyCam AS QWebCam
    ShowErrors = True         'if  errors showmessages
    BitCount = 24
END CREATE

CREATE BMPx  AS QBitmapEx     'capture to our bitmap!
    PixelFormat = pf24bit     'must set this
    Font.Size = 15
    Font.AddStyles(fsBold, fsItalic)
END CREATE
DIM BMPx_pointer AS LONG

DIM RedBMP  AS QBitmap     'a red filter
    RedBMP.PixelFormat = pf24bit     'must set this

DIM BMPxErase AS QBitmapEx  'to remove last capture
    BMPxErase.PixelFormat = pf24bit
    BMPxErase.CopyMode = cmSrcErase

DIM  RedFlag    as integer
DIM  InvFlag    as integer
DIM  Motion1Flag   as integer
DIM  MotionFlag as integer

CREATE MyBitmapForm AS QFORM     'form with bitmap
  CREATE MainMenu AS QMainMenu
  CREATE MainTitle AS QMenuItem
    Caption = "Options"
  CREATE RedMenu AS QMenuItem
    RadioItem = True
    Caption = "red filter"
    OnClick = SetMenuItem
  END CREATE
  CREATE InvertMenu AS QMenuItem
    Caption = "invert"
    OnClick = SetMenuItem
  END CREATE
  CREATE Motion1Menu AS QMenuItem
    Caption = "Motion detect dark"
    OnClick = SetMenuItem
  END CREATE
  CREATE MontionMenu AS QMenuItem
    Caption = "motion detect light"
    OnClick = SetMenuItem
  END CREATE
  END CREATE
  END CREATE
END CREATE

SUB SetMenuItem(Sender AS QMENUITEM)
    RedFlag = False
    InvFlag = False
    Motion1Flag = False
    MotionFlag = False
    IF Sender.Handle = RedMenu.Handle THEN RedFlag = True : BMPx.CopyMode = cmSrcAnd
    IF Sender.Handle = InvertMenu.Handle THEN InvFlag = True :BMPx.CopyMode = cmDstInvert     'cmSrcInvert =inverse with filter
    IF Sender.Handle = Motion1Menu.Handle THEN Motion1Flag = True:  BMPx.CopyMode = cmSrcErase
    IF Sender.Handle = MontionMenu.Handle THEN MotionFlag = True: :  BMPx.CopyMode = cmMergePaint
    'cmNotSrcErase = &H1100A6 ' dest = (NOT src) AND (NOT dest)
    'cmSrcInvert = &H660046  ' dest = source XOR dest
    'cmSrcPaint = &HEE0086  ' dest = source OR dest
END SUB

'=== get it all going  ====
CamForm.ShowModal


SUB StartTheCamUp
    IF MyCam.CamInit(CamForm) THEN
        CamForm.Show
        MyCam.Preview = True
        IF MyCam.SetImageSize(320, 240) = False THEN showmessage "cannot set size"
        MyCam.Resize(CamForm)
        ReSetImage
        CamForm.Caption = "<Enter>options <b>bitmap <s>save img"
    ELSE
        Showmessage "Error: cannot initialize Camera"
        Application.Terminate
    END IF
END SUB


SUB FormKeyDown(Key AS Word, Shift AS INTEGER) 
  SELECT CASE Key

   CASE 27 'esc
	IF MyCam.Preview THEN
		MyCam.Preview = False
	ELSE
		MyCam.Preview = True
	END IF

   CASE 13 'Return
     ReSetImage

   CASE ASC("b"), ASC("B")      'toggle bitmap capture
	IF MyCam.OnFrame THEN
		MyCam.OnFrame = 0&
        MyBitmapForm.Close
	ELSE
		MyCam.OnFrame = CODEPTR(CamFrameEvent)
        IF (MyBitmapForm.ClientWidth <> MyCam.ImageWidth) OR _
            (MyBitmapForm.ClientHeight <> MyCam.ImageHeight) THEN
            ResizeMyBMPs    
        END IF
        MyBitmapForm.Show
	END IF

   CASE ASC("s"), ASC("S")      'toggle bitmap Save
	   IF (MyCam.SaveFrameToFile("test.bmp") = False) THEN ShowMessage "Capture failed"
  END SELECT
END SUB



SUB CleanUp_WebCam
	MyCam.CleanUp			'turns off OnFrameEvent
	IF CamForm.Visible THEN CamForm.Close
END SUB


SUB ReSetImage
    'This code allows the user to set their own video dimensions
    MyCam.ShowDialogBox(1)      '1 = video size, 2=options, 3=display, 4 = compression
    MyCam.GetStatus             'what happened?
    IF MyCam.SetImageSize(MyCam.ImageWidth, MyCam.ImageHeight) = False THEN
        showmessage "cannot set size"
    ELSE
        MyCam.Resize(CamForm)
        ResizeMyBMPs
    END IF
END SUB



SUB ResizeMyBMPs
    MyBitmapForm.ClientWidth = MyCam.ImageWidth
    MyBitmapForm.ClientHeight = MyCam.ImageHeight
    BMPx.Width = MyCam.ImageWidth
    BMPx.Height = MyCam.ImageHeight
    BMPx_pointer = BMPx.Pointer
    RedBMP.Width = MyCam.ImageWidth
    RedBMP.Height = MyCam.ImageHeight
    RedBMP.FillRect(0,0, RedBMP.Width, RedBMP.Height, &HFF)
    BMPxErase.Width = MyCam.ImageWidth
    BMPxErase.Height = MyCam.ImageHeight
END SUB


SUB CamFrameEvent(hCapWnd AS LONG, lpVHdr AS LONG) 'doesn't work with lpVHdr as VIDEOHDR)
    STATIC IsBusy           'we are busy go away

    IF IsBusy = False THEN
        IsBusy = True
     	DIM Hdr AS VIDEOHDR
     	MEMCPY(Hdr, lpVHdr, SIZEOF(Hdr))		'must do this! Can't pass UDT
     	MEMCPY(BMPx_Pointer, (Hdr.lpData), MyCam.ImageWidth * MyCam.ImageHeight * (MyCam.BitCount\8))

        IF (RedFlag OR InvFlag) THEN BMPx.Draw(0,0, RedBMP.BMP)
        IF (Motion1Flag OR MotionFlag) THEN 
            BMPx.Draw(0,0, BMPxErase.BMP)
         	MEMCPY(BMPxErase.Pointer, (Hdr.lpData), MyCam.ImageWidth * MyCam.ImageHeight * (MyCam.BitCount\8))
        ELSE
            BMPx.TextOut(0&, 0&, "Aren't you pretty?", 255, -1)
        END IF
        MyBitmapForm.Draw(0,0, BMPx.BMP)
        IsBusy = False
    END IF
END SUB