FreeBasic

Простой пример работы с вебкамерой. Создает окно и делает снимок с сохранением в файл BMP. Для работы примера нужна библиотека window9

Платформа: Windows
Автор: Marcus Araujo
Адаптировал пример на Freebasic: >Quiet Snow<

' $Lang: "FB"
#INCLUDE Once "window9.bi"
#INCLUDE Once "windows.bi"

#INCLIB "avicap32"

Declare Function capCreateCaptureWindow Alias "capCreateCaptureWindowA" (Byval As LPCSTR , Byval As DWORD, Byval As Integer, Byval As Integer, Byval As Integer, Byval As Integer, Byval As HWND, Byval As Integer) As HWND

#DEFINE WM_CAP_GRAB_FRAME_NOSTOP (WM_USER + 61)

Const IDD_MAIN = 100
Const WM_CAP_DRIVER_CONNECT        =  1024 + 10
Const WM_CAP_DRIVER_DISCONNECT     =  1024 + 11
Const WM_CAP_FILE_SAVEDIB          =  1024 + 25
Const WM_CAP_SET_PREVIEW           =  1024 + 50
Const WM_CAP_SET_PREVIEWRATE       =  1024 + 52
Const WM_CAP_SET_SCALE             =  1024 + 53
Const ID_START                     =  201
Const ID_STOP                      =  202
Const ID_CLICK                     =  203

Dim nDevice As Integer = 0
Dim nFPS    As Integer = 100

Dim hInstance  As HINSTANCE
Dim hWebcam    As HWND
Dim CamTitle   As String

Dim HWnd As HWND, WEvent As Long

hInstance = GetModuleHandle(NULL)
CamTitle = "MYCAM"

HWnd = OpenWindow(CamTitle, 500, 300, 670, 530)
WEvent = 0

hWebcam = capCreateCaptureWindow (Cast(Any Ptr,@CamTitle), WS_VISIBLE + WS_CHILD, 10, 10, 640, 480, HWnd, 1000)
SendMessage (hWebcam, WM_CAP_DRIVER_CONNECT, nDevice, 0 )
SendMessage (hWebcam, WM_CAP_SET_SCALE, 1, 0)
SendMessage (hWebcam, WM_CAP_SET_PREVIEWRATE, nFPS, 0 )
SendMessage (hWebcam, WM_CAP_SET_PREVIEW, 1, 0 )
SendMessage( hWebcam, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0 )
SendMessage( hWebcam, WM_CAP_FILE_SAVEDIB, 0, Cast( LPARAM, @"MyFrame.bmp" ) )

Do
    WEvent = WaitEvent()
    If WEvent = EventClose Then Exit Do
Loop

SendMessage (hWebcam, WM_CAP_DRIVER_DISCONNECT, Cast(WPARAM,@CamTitle), 0 )

CloseWindow (HWnd)