Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example:
#Compile Exe "VideoCapX Demo.exe"
#Dim All
%USEMACROS = 1
#Include Once "WIN32API.INC"
#Include Once "COMMCTRL.INC"
#Include Once "PBForms.INC"
' VideoCapX Class Identifiers
$CLSID_VIDEOCAPXLib_VideoCapX = Guid$("{912FB007-DD9A-11D3-BD8D-DAAFCB8D9378}")
$CLSID_VIDEOCAPXLib_Event__DVideoCapXEvents = Guid$("{9CCCD7DA-17AE-49F9-BEA3-DBCAB557BC05}")
' VideoCapX Interface Identifiers
$IID_VIDEOCAPXLib_Int__DVideoCapX = Guid$("{912FB005-DD9A-11D3-BD8D-DAAFCB8D9378}")
$IID_VIDEOCAPXLib_Int__DVideoCapXEvents = Guid$("{912FB006-DD9A-11D3-BD8D-DAAFCB8D9378}")
%IDD_DIALOG1 = 101
%INVOKE_FUNC = 1
Global hOcx As Dword, oOcx As Dispatch, lastMousePtr As Long
' Dispatch Functions
Declare Function MakeDispatchVariant (ByVal lpObj As Dword, ByRef vObj As Variant) As Long
' ATL Functions
Declare Function AtlAxCreateControlLic Lib "ATL100.DLL" Alias "AtlAxCreateControlLic" (ByVal lpszName As Dword, ByVal hParent As Dword, _
ByVal pStream As Dword, ByRef ppUnkContainer As Dword, ByVal bstrLic As Dword) As Dword
Declare Function AtlAxWinInit Lib "ATL100.DLL" Alias "AtlAxWinInit" () As Long
Declare Function AtlAxWinTerm () As Long
Declare Function AtlAxGetControl Lib "ATL100.DLL" Alias "AtlAxGetControl"(ByVal hWnd As Dword,ByRef pp As Dword) As Dword
Declare Sub AtlMakeDispatch(ByVal lpObj As Dword,ByRef vObj As Variant) ' not used here
' VideoCapX Indirect Access Functions
'--------------------------------------------------------------------------------
' ** Declarations **
'--------------------------------------------------------------------------------
Declare CallBack Function ShowDIALOG1Proc()
Declare Function ShowDIALOG1(ByVal hParent As Dword) As Long
#PBForms DECLARATIONS
'--------------------------------------------------------------------------------
'%PROTECT=1
'--------------------------------------------------------------------------------
Function PBMain()
PBFormsInitComCtls (%ICC_WIN95_CLASSES Or %ICC_DATE_CLASSES Or %ICC_INTERNET_CLASSES)
ShowDIALOG1 %HWND_Desktop
End Function
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** CallBacks **
'--------------------------------------------------------------------------------
Function ShowDIALOG1(ByVal hParent As Dword) As Long
Local OcxName As AsciiZ * 128
Local pUnk As Dword, vVar As Variant, vVar2 As Variant, hInst As Dword, iMax As Long
Local ProgID_VideoCapX As String, LicKey_VideoCapX As String
Local hr As Dword, lrslt As Long
Local hDlg As Dword
Dialog New Pixels, hParent, " VideoCapX Live Video", 147, 149, 887, 507, %WS_Popup _
Or %WS_Border Or %WS_DlgFrame Or %WS_SysMenu Or %WS_ClipSiblings Or _
%WS_Visible Or %DS_ModalFrame Or %DS_Center Or %DS_3DLook Or _
%DS_NoFailCreate Or %DS_SetFont, %WS_Ex_Windowedge Or _
%WS_Ex_ControlParent Or %WS_Ex_Topmost Or %WS_Ex_Left Or _
%WS_Ex_LtrReading Or %WS_Ex_RightScrollbar, To hDlg
AtlAxWinInit ' // Initializes ATL
OcxName = "VIDEOCAPX.VideoCapXCtrl.1"
ProgID_VideoCapX = UCode$("VIDEOCAPX.VideoCapXCtrl.1")
LicKey_VideoCapX = UCode$("VideoCapX LITE ActiveX control - FathSoftware - All Rights Reserved")
hInst = GetModuleHandle(ByVal %NULL)
hOcx = CreateWindowEx(0, "STATIC", "", %WS_Child Or %WS_Visible Or %WS_TabStop, 12, 12, 640, 480, hDlg, ByVal 0, hInst, ByVal %NULL)
hr = AtlAxCreateControlLic(StrPtr(ProgID_VideoCapX), hOcx, ByVal %NULL, ByVal %NULL, StrPtr(LicKey_VideoCapX))
hr = AtlAxGetControl(hOcx, pUnk)
MakeDispatchVariant(pUnk, vVar)
Set oOcx = vVar
' get VideoCapX OCX events like mouse down and mouse up
' vcxEvents = Class "Class_Int__DVideoCapXEvents"
' Events From oOcx Call vcxEvents
' check to make sure a video device is connected
vVar=0 As Long : Object Get oOcx.GetVideoDeviceCount To vVar : iMax=Variant#(vVar)
If iMax=0 Then ' need at least one video device input
MsgBox "No video device. Connect a video device and restart the program",%MB_Ok,"No Device Error"
TerminateProcess GetCurrentProcess, 10
Exit Function
End If
' configure the video device and connect
vVar=0 As Long : Object Let oOcx.VideoDeviceIndex=vVar ' get first video device in the list
vVar=15 As Long : Object Let oOcx.CaptureRate = vVar ' 15 frames/second
vVar=%FALSE As Long : Object Let oOcx.PreviewAudio = vVar ' no audio
vVar=%TRUE : Object Let oOcx.Connected = vVar ' connect to the device
vVar=0 As Long: Object Let oOcx.ColorFormat=vVar ' set color transfer format to RGB
vVar=640 As Long : vVar2=480 As Long : Object Call oOcx.SetVideoFormat(vVar, vVar2) ' 640 x 480 pixels
vVar=%TRUE As Long : Object Let oOcx.Preview = vVar ' preview the live video
Dialog Show Modal hDlg
End Function
' ATL UTILITY FUNCTIONS
'--------------------------------------------------------------------------------
Function AtlAxWinTerm () As Long
UnregisterClass ("AtlAxWin", GetModuleHandle(ByVal %NULL))
End Function
' ********************************************************************************************
' The IUnknown::AddRef method increments the reference count for an interface on an object. It
' should be called for every new copy of a pointer to an interface on a given object.
' ********************************************************************************************
Function IUnknown_AddRef (ByVal pthis As Dword Ptr) As Dword
Local DWRESULT As Dword
If IsFalse pthis Then Exit Function
Call Dword @@pthis[1] Using IUnknown_AddRef(pthis) To DWRESULT
Function = DWRESULT
End Function
' ********************************************************************************************
Sub AtlMakeDispatch(ByVal lpObj As Dword,ByRef vObj As Variant) Export
Local lpvObj As VARIANTAPI Ptr ' Pointer to a VARIANTAPI structure
Let vObj = Empty ' Make sure is empty to avoid memory leaks
lpvObj = VarPtr(vObj) ' Get the VARIANT address
@lpvObj.vt = %VT_Dispatch ' Mark it as containing a dispatch variable
@lpvObj.vd.pdispVal = lpObj ' Set the dispatch pointer address
IUnknown_AddRef lpObj ' Increment the reference counter -- added 12/05/05
End Sub
Function MakeDispatchVariant (ByVal lpObj As Dword, ByRef vObj As Variant) As Long
Local lpvObj As VARIANTAPI Ptr ' Pointer to a VARIANTAPI structure
Let vObj = Empty ' Make sure is empty to avoid memory leaks
If lpObj = 0 Then Exit Function ' Null pointer
lpvObj = VarPtr(vObj) ' Get the VARIANT address
@lpvObj.vt = %VT_Dispatch ' Mark it as containing a dispatch variable
@lpvObj.vd.pdispVal = lpObj ' Set the dispatch pointer address
IUnknown_AddRef lpObj ' Increment the reference counter
Function = -1
End Function
http://www.garybeene.com/sw/gbsnippets.htm