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