Autor
esto es lo que estoy haciendo, intento disparar el callback de una webcam dentro de un modulo clase
Código:
Option Explicit
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Integer, ByVal hWndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WM_USER As Long = &H400
Private Const WM_CAP_START As Long = WM_USER
Private Const WM_CAP_SET_CALLBACK_FRAME As Long = WM_CAP_START + 5
Private Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Private Const WM_CAP_GET_VIDEOFORMAT As Long = WM_CAP_START + 44
Private Const WM_CAP_GRAB_FRAME As Long = WM_CAP_START + 60
Private Type VIDEOHDR
lpData As Long
dwBufferLength As Long
dwBytesUsed As Long
dwTimeCaptured As Long
dwUser As Long
dwFlags As Long
dwReserved(3) As Long
End Type
Private bvASM(40) As Byte
Private hwndCap As Long
Public Function FrameCallBack(ByVal lWnd As Long, ByVal lpVHdr As Long) As Long
Debug.Print "FUNCIONA!"
End Function
Public Function Capture()
Call SendMessage(hwndCap, WM_CAP_GRAB_FRAME, ByVal 0&, ByVal 0&)
End Function
Public Function CreateCaptureWindow() As Boolean
hwndCap = capCreateCaptureWindowA(vbNullString, 0&, 0&, 0&, 0&, 0&, 0&, 0&)
If hwndCap Then
Call SendMessage(hwndCap, WM_CAP_SET_CALLBACK_FRAME, 0, GetAdressMe(Me))
CreateCaptureWindow = True
End If
End Function
Function capGetVideoFormat(ByVal hCapWnd As Long, ByVal CapFormatSize As Long, ByVal BmpFormat As Long) As Long
capGetVideoFormat = SendMessage(hCapWnd, WM_CAP_GET_VIDEOFORMAT, CapFormatSize, BmpFormat)
End Function
Public Function DestroyCaptureWindow() As Boolean
If hwndCap Then DestroyCaptureWindow = DestroyWindow(hwndCap): hwndCap = 0
End Function
Public Function ConnectDriver() As Boolean
If hwndCap Then ConnectDriver = SendMessage(hwndCap, WM_CAP_DRIVER_CONNECT, 0&, 0&)
End Function
Public Function DisconnectDriver() As Boolean
If hwndCap Then
Call SendMessage(hwndCap, WM_CAP_SET_CALLBACK_FRAME, 0&, vbNull)
DisconnectDriver = SendMessage(hwndCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End If
End Function
Private Function GetAdressMe(Obj As Object) As Long
Dim WindowProcAddress As Long
Dim pObj As Long
Dim pVar As Long
Dim i As Long
For i = 0 To 40
bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
&HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
&HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
Next i
pObj = ObjPtr(Obj)
Call CopyMemory(pVar, ByVal pObj, 4)
Call CopyMemory(WindowProcAddress, ByVal (pVar + 28), 4)
Call LongToByte(pObj, bvASM, 23)
Call LongToByte(WindowProcAddress, bvASM, 28)
GetAdressMe = VarPtr(bvASM(0))
End Function
Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
bReturn(i) = lLong And &HFF
bReturn(i + 1) = (lLong And 65280) / &H100
bReturn(i + 2) = (lLong And &HFF0000) / &H10000
bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub
en el formulario con un boton
Código:
Option Explicit
Dim C1 As Class1
Private Sub Command1_Click()
C1.Capture
End Sub
Private Sub Form_Load()
Set C1 = New Class1
C1.CreateCaptureWindow
C1.ConnectDriver
End Sub
Private Sub Form_Unload(Cancel As Integer)
C1.DisconnectDriver
C1.DestroyCaptureWindow
Set C1 = Nothing
End Sub
En línea
