Webcam API Still Works, Surprisingly

[SpriggsySpriggs]

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"