10-25-2024, 03:12 PM
Code: (Select All)
Option _Explicit
'$CONSOLE:ONLY
'_DEST _CONSOLE
'Window Style Constants
Const WS_BORDER = &H00800000
Const WS_CAPTION = &H00C00000
Const WS_CHILD = &H40000000
Const WS_CHILDWINDOW = WS_CHILD
Const WS_CLIPCHILDREN = &H02000000
Const WS_CLIPSIBLINGS = &H04000000
Const WS_DISABLED = &H08000000
Const WS_DLGFRAME = &H00400000
Const WS_GROUP = &H00020000
Const WS_HSCROLL = &H00100000
Const WS_ICONIC = &H20000000
Const WS_MAXIMIZE = &H01000000
Const WS_MAXIMIZEBOX = &H00010000
Const WS_MINIMIZE = &H20000000
Const WS_MINIMIZEBOX = &H00020000
Const WS_OVERLAPPED = &H00000000
Const WS_POPUP = &H80000000
Const WS_SIZEBOX = &H00040000
Const WS_SYSMENU = &H00080000
Const WS_TABSTOP = &H00010000
Const WS_THICKFRAME = &H00040000
Const WS_TILED = &H00000000
Const WS_VISIBLE = &H10000000
Const WS_VSCROLL = &H00200000
Const WS_TILEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Const WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'------------------------------------------------------------------------------------------------------------------------------
'Capture Driver Constants
Const WM_CAP_START = &H0400
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_GRAB_FRAME = WM_CAP_START + 60
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_STOP = WM_CAP_START + 68
Const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14
Const WM_CAP_GET_STATUS = WM_CAP_START + 54
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43
Const WM_CAP_SEQUENCE = WM_CAP_START + 62
Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61
Const WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_START + 20
Const WM_CAP_SINGLE_FRAME = WM_CAP_START + 70
Const WM_CAP_SET_AUDIOFORMAT = WM_CAP_START + 35
Const WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46
'------------------------------------------------------------------------------------------------------------------------------
'Window Pos Constants
Const SWP_ASYNCWINDOWPOS = &H4000
Const SWP_DEFERERASE = &H2000
Const SWP_DRAWFRAME = &H0020
Const SWP_FRAMECHANGED = &H0020
Const SWP_HIDEWINDOW = &H0080
Const SWP_NOACTIVATE = &H0010
Const SWP_NOCOPYBITS = &H0100
Const SWP_NOMOVE = &H0002
Const SWP_NOOWNERZORDER = &H0200
Const SWP_NOREDRAW = &H0008
Const SWP_NOREPOSITION = &H0200
Const SWP_NOSENDCHANGING = &H0400
Const SWP_NOSIZE = &H0001
Const SWP_NOZORDER = &H0004
Const SWP_SHOWWINDOW = &H0040
'------------------------------------------------------------------------------------------------------------------------------
Const WAVE_FORMAT_PCM = 1
Type CapDriverCaps
DeviceIndex As _Unsigned Long
HasOverlay As _Byte
HasDlgVideoSource As _Byte
HasDlgVideoFormat As _Byte
HasDlgVideoDisplay As _Byte
CaptureInitialized As _Byte
DriverSuppliesPalettes As _Byte
hVideoIn As Long
hVideoOut As Long
hVideoExtIn As Long
hVideoExtOut As Long
End Type
Type POINTAPI
x As Long
y As Long
End Type
Type CapStatus
ImageWidth As _Unsigned Long
ImageHeight As _Unsigned Long
LiveWindow As _Byte
OverlayWindow As _Byte
Scale As _Byte
Scroll As POINTAPI
UsingDefaultPalette As _Byte
AudioHardware As _Byte
CapFileExists As _Byte
CurrentVideoFrame As Long
CurrentVideoFramesDropped As Long
CurrentWaveSamples As Long
CurrentTimeElapsedMS As Long
PalCurrent As Long
CapturingNow As _Byte
RETURN As Long
NumVideoAllocated As _Unsigned Long
NumAudioAllocated As _Unsigned Long
End Type
Type WAVEFORMATEX
FormatTag As Integer
Channels As Integer
SamplesPerSec As Long
AvgBytesPerSec As Long
BlockAlign As Integer
BitsPerSample As Integer
cbSize As Integer
End Type
Declare Dynamic Library "Avicap32"
Function CreateCaptureWindow& Alias capCreateCaptureWindowA (lpszWindowName As String, Byval dwStyle As _Offset, Byval x As Integer, Byval y As Integer, Byval nWidth As Integer, Byval nHeight As Integer, Byval hwndParent As _Integer64, Byval nId As Integer)
Function GetDriverDescription%% Alias capGetDriverDescriptionA (ByVal wDriverIndex As _Unsigned Long, Byval lpszName As _Offset, Byval cbName As Integer, Byval lpszVer As _Offset, Byval cbVer As Integer)
End Declare
Declare Dynamic Library "User32"
Function SendMessage& Alias SendMessageA (ByVal hWnd As Long, Byval Msg As _Unsigned Integer, Byval wParam As Long, Byval lParam As _Offset)
Function SetWindowPos%% (ByVal hWnd As Long, Byval hWndInsertAfter, Byval X As Integer, Byval Y As Integer, Byval cx As Integer, Byval cy As Integer, Byval uFlags As _Unsigned Long)
Function DestroyWindow%% (ByVal hWnd As Long)
End Declare
Declare Dynamic Library "WINMM"
Function mciSendString% Alias mciSendStringA (lpstrCommand As String, lpstrReturnString As String, Byval uReturnLength As _Unsigned Long, Byval hwndCallback As Long)
Function mciGetErrorString% Alias mciGetErrorStringA (ByVal dwError As Long, lpstrBuffer As String, Byval uLength As _Unsigned Long)
End Declare
Screen _NewImage(720, 480, 32)
Dim childWin As _Integer64
Dim a As Long
Dim captureWinText As String
captureWinText = "Webcam API Test" + Chr$(0)
Dim childID As _Integer64
childWin = CreateCaptureWindow(captureWinText, WS_CHILD Or WS_VISIBLE, 0, 0, 720, 480, _WindowHandle, childID)
_Title "Webcam API Test"
Print childWin
a = SendMessage(childWin, WM_CAP_DRIVER_CONNECT, 0, 0)
Dim DeviceName As String * 80
Dim DeviceVersion As String * 80
Dim wIndex As _Unsigned Integer
'FOR wIndex = 0 TO 10
'DeviceName = SPACE$(80)
'DeviceVersion = SPACE$(80)
a = GetDriverDescription(wIndex, _Offset(DeviceName), Len(DeviceName), _Offset(DeviceVersion), Len(DeviceVersion))
'PRINT DeviceName, DeviceVersion
'NEXT
Dim driverCaps As CapDriverCaps
driverCaps.DeviceIndex = 0
a = SendMessage(childWin, WM_CAP_DRIVER_GET_CAPS, Len(driverCaps), _Offset(driverCaps))
Dim capstatus As CapStatus
Dim filename As String
filename = "Video.avi" + Chr$(0)
If _FileExists(filename) Then
Kill filename
End If
Dim wave As WAVEFORMATEX
wave.FormatTag = WAVE_FORMAT_PCM
wave.Channels = 2
wave.SamplesPerSec = 48000
wave.AvgBytesPerSec = 192000
wave.BlockAlign = 4
wave.BitsPerSample = 16
wave.cbSize = 0
a = SendMessage(childWin, WM_CAP_SET_SCALE, -1, 0)
a = SendMessage(childWin, WM_CAP_SET_PREVIEWRATE, 16.7, 0)
a = SendMessage(childWin, WM_CAP_SET_PREVIEW, -1, 0)
a = SendMessage(childWin, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
a = SendMessage(childWin, WM_CAP_DLG_VIDEOSOURCE, 0, 0)
'a = SendMessage(childWin, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0)
a = SendMessage(childWin, WM_CAP_FILE_SET_CAPTURE_FILE, 0, _Offset(filename))
a = SendMessage(childWin, WM_CAP_SET_AUDIOFORMAT, Len(wave), _Offset(wave))
a = SendMessage(childWin, WM_CAP_SEQUENCE, 0, 0)
a = SendMessage(childWin, WM_CAP_GET_STATUS, Len(capstatus), _Offset(capstatus))
'a = SetWindowPos(childWin, 0, 0, 0, capstatus.ImageWidth, capstatus.ImageHeight, SWP_NOZORDER OR SWP_NOMOVE)
Do
If Not SendMessage(childWin, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0) Then Exit Do 'Press escape or make the window lose focus to stop recording
'IF _WINDOWHASFOCUS = 0 THEN EXIT DO
_Limit 60
Loop Until InKey$ <> ""
Print "Disconnecting Driver:", SendMessage(childWin, WM_CAP_DRIVER_DISCONNECT, 0, 0)
a = DestroyWindow(childWin)
Print "Destroyed"
Tread on those who tread on you