Slighthaze = [color blue]NULL[/color]
[img http://www.sweetpotatosoftware.com/ttimages/webcam.gif]
In order for this example to work on your system you will need Webcam (or comparable device) and you will need to download the EzVidC60.ocx from http://www.shrinkwrapvb.com/ezvidcap.htm (if this link ever becomes broken please email me "craig at craigsboyd dot com"). The ocx is freeware by Ray Mercer and you can freely distribute it with your applications. You will find some documentation on the control and a VB example in the download. I have taken the time to rework the example application Ray Mercer provides into a VFP Class. I think the control is pretty good, really good for freeware! (After you have registered EzVidC60.ocx on your system CUT-N-PASTE the code below into a prg file and run it) PUBLIC oForm
oForm = CREATEOBJECT("clsWebcam")
oForm.show()
DEFINE CLASS clswebcam AS form
Top = 0
Left = 0
Height = 560
Width = 647
DoCreate = .T.
Caption = "Form"
Name = "clswebcam"
ADD OBJECT shape1 AS shape WITH ;
Top = 507, ;
Left = 23, ;
Height = 34, ;
Width = 589, ;
SpecialEffect = 0, ;
Name = "Shape1"
ADD OBJECT ezvidcap1 AS olecontrol WITH ;
Top = 24, ;
Left = 123, ;
Height = 100, ;
Width = 100, ;
Name = "ezVidCap1", ;
OleClass = "vbVidC60.ezVidCap"
ADD OBJECT cmdcapture AS commandbutton WITH ;
Top = 24, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Capture Video", ;
Name = "cmdCapture"
ADD OBJECT cmdformatdlg AS commandbutton WITH ;
Top = 60, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Format DLG", ;
Name = "cmdFormatDlg"
ADD OBJECT cmddisplaydlg AS commandbutton WITH ;
Top = 96, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Display DLG", ;
Name = "cmdDisplayDlg"
ADD OBJECT cmdsourcedlg AS commandbutton WITH ;
Top = 132, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Source DLG", ;
Name = "cmdSourceDlg"
ADD OBJECT cmdcompdlg AS commandbutton WITH ;
Top = 168, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Comp DLG", ;
Name = "cmdCompDlg"
ADD OBJECT cmdaudiodlg AS commandbutton WITH ;
Top = 204, ;
Left = 24, ;
Height = 27, ;
Width = 84, ;
Caption = "Audio DLG", ;
Name = "cmdAudioDlg"
ADD OBJECT chkaudio AS checkbox WITH ;
Top = 305, ;
Left = 24, ;
Height = 17, ;
Width = 96, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Capture Audio", ;
Name = "chkAudio"
ADD OBJECT chkuserconfirm AS checkbox WITH ;
Top = 329, ;
Left = 24, ;
Height = 17, ;
Width = 287, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Show VFW defined user dialog to confirm capture", ;
Name = "chkUserConfirm"
ADD OBJECT chkpreroll AS checkbox WITH ;
Top = 353, ;
Left = 24, ;
Height = 17, ;
Width = 230, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Use Precise Capture Controls (Preroll)", ;
Name = "chkPreRoll"
ADD OBJECT chkpreview AS checkbox WITH ;
Top = 377, ;
Left = 24, ;
Height = 17, ;
Width = 93, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Preview video", ;
Name = "chkPreview"
ADD OBJECT chkframecallback AS checkbox WITH ;
Top = 401, ;
Left = 24, ;
Height = 17, ;
Width = 177, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Enable FrameCallback Event", ;
Name = "chkFrameCallback"
ADD OBJECT chkautosize AS checkbox WITH ;
Top = 425, ;
Left = 24, ;
Height = 17, ;
Width = 68, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Auto Size", ;
Name = "chkAutoSize"
ADD OBJECT chkcenter AS checkbox WITH ;
Top = 449, ;
Left = 24, ;
Height = 17, ;
Width = 82, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Auto Center", ;
Name = "chkCenter"
ADD OBJECT chkstretch AS checkbox WITH ;
Top = 473, ;
Left = 24, ;
Height = 17, ;
Width = 102, ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Stretch Preview", ;
Name = "chkStretch"
ADD OBJECT cmdwidth AS commandbutton WITH ;
Top = 423, ;
Left = 204, ;
Height = 27, ;
Width = 84, ;
Caption = "Set Width", ;
Name = "cmdWidth"
ADD OBJECT cmdheight AS commandbutton WITH ;
Top = 459, ;
Left = 204, ;
Height = 27, ;
Width = 84, ;
Caption = "Set Height", ;
Name = "cmdHeight"
ADD OBJECT spnwidth AS spinner WITH ;
Height = 24, ;
Left = 300, ;
Top = 423, ;
Width = 84, ;
Name = "spnWidth"
ADD OBJECT spnheight AS spinner WITH ;
Height = 24, ;
Left = 300, ;
Top = 459, ;
Width = 84, ;
Name = "spnHeight"
ADD OBJECT cmdsaveas AS commandbutton WITH ;
Top = 423, ;
Left = 420, ;
Height = 27, ;
Width = 84, ;
Caption = "Save AVI", ;
Name = "cmdSaveAs"
ADD OBJECT cmdsavedib AS commandbutton WITH ;
Top = 423, ;
Left = 520, ;
Height = 27, ;
Width = 91, ;
Caption = "Save DIB", ;
Name = "cmdSaveDIB"
ADD OBJECT cbdriver AS combobox WITH ;
Height = 24, ;
Left = 420, ;
Top = 459, ;
Width = 192, ;
Name = "cbDriver"
ADD OBJECT lblstatuscode AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Status Code", ;
Height = 17, ;
Left = 47, ;
Top = 516, ;
Width = 70, ;
ForeColor = RGB(255,0,0), ;
Name = "lblStatusCode"
ADD OBJECT lblstatusstring AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Status String", ;
Height = 17, ;
Left = 315, ;
Top = 516, ;
Width = 72, ;
Name = "lblStatusString"
PROCEDURE Load
_vfp.AutoYield = .f.
ENDPROC
PROCEDURE Init
LOCAL i
thisform.EnableButtons() &&check device caps and enable appropriate btns
thisform.Refresh()
If 0 < thisform.ezVidCap1.NumCapDevs
For i = 0 To thisform.ezVidCap1.NumCapDevs - 1
thisform.cbDriver.AddItem (thisform.ezVidCap1.GetDriverName(i))
endfor
thisform.cbDriver.ListIndex = thisform.ezVidCap1.DriverIndex
Else
thisform.cbDriver.AddItem ("<none>")
thisform.cbDriver.ListIndex = 0
MESSAGEBOX("No Video Capture Device!",64,thisform.Caption)
EndIf
*init form with current properties
thisform.lblStatusCode.caption = "Status Panel"
thisform.lblStatusString.caption = thisform.ezVidCap1.GetDriverVersion()
thisform.spnWidth.value = thisform.ezVidCap1.Width
thisform.spnHeight.value = thisform.ezVidCap1.Height
thisform.chkAutoSize.Value = thisform.ezVidCap1.AutoSize
thisform.chkCenter.Value = thisform.ezVidCap1.CenterVideo
thisform.chkStretch.Value = thisform.ezVidCap1.StretchPreview
thisform.chkAudio.Value = thisform.ezVidCap1.CaptureAudio
thisform.chkPreRoll.Value = thisform.ezVidCap1.UsePreciseCaptureControls
thisform.chkUserConfirm.Value = thisform.ezVidCap1.MakeUserConfirmCapture
thisform.chkPreview.Value = thisform.ezVidCap1.Preview
thisform.chkFrameCallback.Value = thisform.ezVidCap1.FrameEventEnabled
thisform.Refresh()
ENDPROC
PROCEDURE MessWithVidBits
*Still working on this sorry
ENDPROC
PROCEDURE enablebuttons
WITH thisform
.cmdAudioDlg.Enabled = .F.
.cmdFormatDlg.Enabled = .F.
.cmdDisplayDlg.Enabled = .F.
.cmdSourceDlg.Enabled = .F.
.cmdCapture.Enabled = .F.
.cmdCompDlg.Enabled = .F.
With .ezVidCap1
If .NumCapDevs > 0
thisform.cmdCapture.Enabled = .T.
thisform.cmdCompDlg.Enabled = .T.
EndIf
If .HasAudio
thisform.cmdAudioDlg.Enabled = .T.
endif
If .HasDlgFormat
thisform.cmdFormatDlg.Enabled = .T.
endif
If .HasDlgDisplay
thisform.cmdDisplayDlg.Enabled = .T.
endif
If .HasDlgSource
thisform.cmdSourceDlg.Enabled = .T.
endif
EndWith
endwith
ENDPROC
PROCEDURE ezvidcap1.StatusMessage
*** ActiveX Control Event ***
LPARAMETERS statcode, statstring
thisform.lblStatusCode.Caption = "StatusCode: " + StatCode
If StatCode <> 0
thisform.lblStatusString.Caption = StatString
EndIf
thisform.Refresh()
ENDPROC
PROCEDURE ezvidcap1.ErrorMessage
*** ActiveX Control Event ***
LPARAMETERS errcode, errstring
If ErrCode <> 0
thisform.lblStatusString.caption = "Error " + ErrString
EndIf
ENDPROC
PROCEDURE ezvidcap1.CaptureYield
*** ActiveX Control Event ***
DOEVENTS
ENDPROC
PROCEDURE ezvidcap1.FrameCallback
*** ActiveX Control Event ***
LPARAMETERS lpvhdr
=thisform.MessWithVidBits(lpVHdr)
ENDPROC
PROCEDURE ezvidcap1.PreRollComplete
*** ActiveX Control Event ***
Local userRet
userRet = MessageBox("Using precise capture controls." +CHR(13) + CHR(10) +;
"PreRoll complete - Click OK to start capture immediately.",1, thisform.caption)
If userRet = 1
thisform.ezVidCap1.PreciseCaptureStart
Else
thisform.ezVidCap1.PreciseCaptureCancel
EndIf
ENDPROC
PROCEDURE cmdcapture.Click
thisform.ezVidCap1.CaptureVideo()
ENDPROC
PROCEDURE cmdformatdlg.Click
thisform.ezVidCap1.ShowDlgVideoFormat()
ENDPROC
PROCEDURE cmddisplaydlg.Click
thisform.ezVidCap1.ShowDlgVideoDisplay()
ENDPROC
PROCEDURE cmdsourcedlg.Click
thisform.ezVidCap1.ShowDlgVideoSource()
ENDPROC
PROCEDURE cmdcompdlg.Click
thisform.ezVidCap1.ShowDlgCompressionOptions()
ENDPROC
PROCEDURE cmdaudiodlg.Click
thisform.ezVidCap1.ShowDlgAudioFormat()
ENDPROC
PROCEDURE chkaudio.InteractiveChange
If thisform.chkAudio.Value = .T.
thisform.ezVidCap1.CaptureAudio = .T.
Else
thisform.ezVidCap1.CaptureAudio = .F.
EndIf
ENDPROC
PROCEDURE chkuserconfirm.InteractiveChange
If thisform.chkUserConfirm.Value = .t.
thisform.ezVidCap1.MakeUserConfirmCapture = .T.
Else
thisform.ezVidCap1.MakeUserConfirmCapture = .F.
EndIf
ENDPROC
PROCEDURE chkpreroll.InteractiveChange
If thisform.chkPreRoll.Value = .t.
thisform.ezVidCap1.UsePreciseCaptureControls = .T.
Else
thisform.ezVidCap1.UsePreciseCaptureControls = .F.
EndIf
ENDPROC
PROCEDURE chkpreview.InteractiveChange
If thisform.chkPreview.Value = .t.
thisform.ezVidCap1.Preview = .T.
Else
thisform.ezVidCap1.Preview = .F.
EndIf
ENDPROC
PROCEDURE chkframecallback.InteractiveChange
If thisform.chkFrameCallback.Value = .t.
thisform.ezVidCap1.FrameEventEnabled = .T.
Else
thisform.ezVidCap1.FrameEventEnabled = .F.
EndIf
ENDPROC
PROCEDURE chkautosize.InteractiveChange
If thisform.chkAutoSize.Value = .t.
thisform.ezVidCap1.AutoSize = .T.
Else
thisform.ezVidCap1.AutoSize = .F.
EndIf
ENDPROC
PROCEDURE chkcenter.InteractiveChange
If thisform.chkCenter.Value = .t.
thisform.ezVidCap1.CenterVideo = .T.
Else
thisform.ezVidCap1.CenterVideo = .F.
EndIf
ENDPROC
PROCEDURE chkstretch.InteractiveChange
If thisform.chkStretch.Value = .t.
thisform.ezVidCap1.StretchPreview = .T.
Else
thisform.ezVidCap1.StretchPreview = .F.
EndIf
ENDPROC
PROCEDURE cmdwidth.Click
thisform.ezVidCap1.Width = thisform.spnWidth.value
*show actual size (in case auto size is turned on)
thisform.spnWidth.value = thisform.ezVidCap1.Width
ENDPROC
PROCEDURE cmdheight.Click
thisform.ezVidCap1.Height = thisform.spnHeight.value
*show actual size (in case auto size is turned on)
thisform.spnHeight.value = thisform.ezVidCap1.Height
ENDPROC
PROCEDURE cmdsaveas.Click
LOCAL cFile
cFile = PUTFILE('AVI files', 'capture.avi', 'AVI')
IF !EMPTY(cFile)
thisform.ezVidCap1.SaveAs(cFile)
ENDIF
ENDPROC
PROCEDURE cmdsavedib.Click
LOCAL cFile
cFile = PUTFILE('Bitmap files', 'capture.bmp', 'BMP')
IF !EMPTY(cFile)
thisform.ezVidCap1.SaveDIB(cFile)
ENDIF
ENDPROC
PROCEDURE cbdriver.InteractiveChange
Local oldDriver
oldDriver = thisform.ezVidCap1.DriverIndex
On ERROR *
thisform.ezVidCap1.DriverIndex = thisform.cbDriver.ListIndex
If ERROR()
*restore old settings
thisform.ezVidCap1.DriverIndex = oldDriver
thisform.cbDriver.ListIndex = oldDriver
thisform.lblStatusString.caption = "Could not connect!"
EndIf
ENDPROC
ENDDEFINE
