' Grab_webcam.bas by Volta
' auf FB020 nur unter ME getestet!
#INCLUDE ONCE "win\vfw.bi" 'die vfw.bi includet die windows.bi

DECLARE SUB CamCap_init
DECLARE SUB CamCap_off (i AS INTEGER= 1)
DECLARE FUNCTION GRAB_FRAME2Image(BYVAL hWin AS INTEGER _
,            BYVAL lpHeader AS VIDEOHDR PTR) AS INTEGER

TYPE RGB32 FIELD = 1
  AS BYTE b,g,r,a
END TYPE

DIM SHARED AS INTEGER cam_breite, cam_hoehe, CamPosX, CamPosY
DIM SHARED AS INTEGER PTR cap_image
DIM SHARED AS HWND hCapture
DIM SHARED AS BITMAPINFOHEADER biheader

DIM ik AS STRING
SCREEN 18,32
CamPosX=0
CamPosY=19
CamCap_init
SCREENRES cam_breite,cam_hoehe+20,32
WIDTH cam_breite\8,(cam_hoehe+20)\16
cap_image = IMAGECREATE(cam_breite,cam_hoehe)
DO
  LOCATE 1,2 : ? TIME
  capGrabFrame(hCapture)
  SCREENLOCK
  PUT (CamPosX,CamPosY),cap_image,PSET
  SCREENUNLOCK
  SLEEP 1
  Ik = INKEY
LOOP UNTIL Ik = CHR(3) OR Ik = CHR(27) OR Ik = CHR(255,107)

CamCap_off 0
END

FUNCTION GRAB_FRAME2Image(BYVAL hWin AS INTEGER _
  ,  BYVAL lpHeader AS VIDEOHDR PTR) AS INTEGER
  DIM AS INTEGER picsize, zeile, x, y, j
  DIM AS RGB32 PTR lpScreen
  picsize = lpHeader->dwBytesUsed\3
  IF picsize = cam_breite * cam_hoehe THEN
    'Byte für Byte in das Image schaufeln
    zeile = cam_breite * (cam_hoehe-1)
    lpScreen = CPTR(RGB32 PTR,(cap_image))+8
    FOR y = 0 TO cam_hoehe-1
      FOR x = 0 TO cam_breite-1
        lpScreen[zeile+x].b = lpHeader->lpData
        [j]lpScreen[zeile+x].g = lpHeader->lpData[j+1]
        lpScreen[zeile+x].r = lpHeader->lpData[j+2]
        j+ = 3
      NEXT
      zeile -= cam_breite
    NEXT
  ELSE
    RETURN 0
  END IF
  RETURN 1
END FUNCTION

SUB CamCap_off (i AS INTEGER)
  capDriverDisconnect(hCapture)
  IF cap_image<>0 THEN IMAGEDESTROY cap_image
  IF i THEN SLEEP
  END
END SUB

SUB CamCap_init
  hCapture = capCreateCaptureWindow(@"Voltas Grab_Cam_Picture" _
  , &H40000000, 0, 0, 0, 0, FindWindow(0, 0), 0)
  IF hCapture = 0 THEN
    ? "error: can't create capture window !"
    CamCap_off 1
  END IF

  IF capDriverConnect(hCapture, 0) <> 1 THEN 'für die erste WebCam,
    '          sonst (hCapture, n) n =1,2,3 ...
    ? "error: can't connect the driver !"
    CamCap_off 1
  END IF

  capGetVideoFormat(hCapture, @biHeader, SIZEOF(BITMAPINFOHEADER))
  IF (biHeader.biCompression <> 0) THEN
    ?"error: sorry this example needs RGB format!"
    CamCap_off 1
  END IF

  cam_breite = biHeader.biWidth
  cam_hoehe = biHeader.biHeight
  capSetCallbackOnFrame(hCapture, @GRAB_FRAME2Image)
END SUB

D:\Programs\FreeBasics\FreeBasic\FBC\inc\win\vfw.bi(1742) error 59: Illegal specification, at parameter 1 (lpofn) of GetOpenFileNamePreviewA() in 'declare function GetOpenFileNamePreviewA(byval lpofn as LPOPENFILENAMEA) as WINBOOL'

#define AVICapSM(hwnd, m, w, l) iif(IsWindow(hwnd), SendMessage(hwnd, m, w, l), 0)

'function    capDriverConnect(hwnd: HWND; i: INT): BOOL;
'begin
'    Result  := AVICapSM(hwnd, WM_CAP_DRIVER_CONNECT, i, 0) <> 0;
'end;

'function    capGetVideoFormat(hwnd: HWND; s: PVOID; wSize: WORD): DWORD;
'begin
'    Result  := AVICapSM(hwnd, WM_CAP_GET_VIDEOFORMAT, wSize, LPARAM(s));
'end;

 FUNCTION capDriverConnect(hwnd AS HWND, i AS INTEGER) AS BOOLEAN

    IF IsWindow(hwnd) <> 0 THEN
      SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, i, 0)
    END IF

END FUNCTION

#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win\commdlg.bi"
#INCLUDE ONCE "win\vfw.bi"

#include once "windows.bi"
#include once "win\commdlg.bi"
#INCLUDE ONCE "win\vfw.bi"

DECLARE SUB CamCap_init
DECLARE SUB CamCap_off (i AS INTEGER= 1)
DECLARE FUNCTION GRAB_FRAME2Image(BYVAL hWin AS INTEGER _
,            BYVAL lpHeader AS VIDEOHDR PTR) AS INTEGER

TYPE RGB32 FIELD = 1
  AS BYTE b,g,r,a
END TYPE

DIM SHARED AS INTEGER cam_breite, cam_hoehe, CamPosX, CamPosY
DIM SHARED AS INTEGER PTR cap_image
DIM SHARED AS HWND hCapture
DIM SHARED AS BITMAPINFOHEADER biheader

DIM ik AS STRING
SCREEN 18,32
CamPosX=0
CamPosY=19
CamCap_init
SCREENRES cam_breite,cam_hoehe+20,32
WIDTH cam_breite\8,(cam_hoehe+20)\16
cap_image = IMAGECREATE(cam_breite,cam_hoehe)
DO
  LOCATE 1,2 : ? TIME
  dim as WinBOOL wRes = capGrabFrame(hCapture)
  SCREENLOCK
  PUT (CamPosX,CamPosY),cap_image,PSET
  SCREENUNLOCK
  SLEEP 1
  Ik = INKEY
LOOP UNTIL Ik = CHR(3) OR Ik = CHR(27) OR Ik = CHR(255,107)

CamCap_off 0
END

FUNCTION GRAB_FRAME2Image(BYVAL hWin AS INTEGER _
  ,  BYVAL lpHeader AS VIDEOHDR PTR) AS INTEGER
  DIM AS INTEGER picsize, zeile, x, y, j
  DIM AS RGB32 PTR lpScreen
  picsize = lpHeader->dwBytesUsed\3
  IF picsize = cam_breite * cam_hoehe THEN
    
    zeile = cam_breite * (cam_hoehe-1)
    lpScreen = CPTR(RGB32 PTR,(cap_image))+8
    FOR y = 0 TO cam_hoehe-1
      FOR x = 0 TO cam_breite-1
        lpScreen[zeile+x].b = lpHeader->lpData[j]
        lpScreen[zeile+x].g = lpHeader->lpData[j+1]
        lpScreen[zeile+x].r = lpHeader->lpData[j+2]
        j+ = 3
      NEXT
      zeile -= cam_breite
    NEXT
  ELSE
    RETURN 0
  END IF
  RETURN 1
END FUNCTION

SUB CamCap_off (i AS INTEGER)
  dim as WinBOOL wRes = capDriverDisconnect(hCapture)
  IF cap_image<>0 THEN IMAGEDESTROY cap_image
  IF i THEN SLEEP
  END
END SUB

SUB CamCap_init
  hCapture = capCreateCaptureWindow(@"Voltas Grab_Cam_Picture" _
  , &H40000000, 0, 0, 0, 0, FindWindow(0, 0), 0)
  IF hCapture = 0 THEN
    ? "error: can't create capture window !"
    CamCap_off 1
  END IF

  IF capDriverConnect(hCapture, 0) <> 1 THEN
    
    ? "error: can't connect the driver !"
    CamCap_off 1
  END IF

  dim as WinBOOL wRes = capGetVideoFormat(hCapture, @biHeader, SIZEOF(BITMAPINFOHEADER))
  IF (biHeader.biCompression <> 0) THEN
    ?"error: sorry this example needs RGB format!"
    CamCap_off 1
  END IF

  cam_breite = biHeader.biWidth
  cam_hoehe = biHeader.biHeight
  wRes = capSetCallbackOnFrame(hCapture, @GRAB_FRAME2Image)
END SUB

попробуй вначале записать эти хедеры:

Так что , правильно или неправильно работает , не знаю.

InitStage = 1
LastStage = 3

  DO
   '  Шаги инициализации
   SELECT CASE  InitStage
     '  Деинициализация устройства\модуля при неудаче
     '  И рестарт инициализации
     CASE 0
        Try = Try + 1                    '  Кол-во попыток
        IF Try = MaxTry THEN EXIT DO     '  Выход если все попытки сделали
        InitStage = 1

     '  Шаги инициализации
     CASE 1
     CASE 2
     CASE 3
   END SELECT
   '  Следующий шаг
   IF InitStage > 0 THEN InitStage += 1

  LOOP UNTIL InitStage > LastStage

Sub Destructor.

Function Initialize() As Boolean

   Dim CurrentStep As Integer
   
   For i As Integer = 0 To InitStepsMaximum
      Select Case i
         Case 0
            ' создать память
            p = Allocate(...)
            
            If p = 0 Then
               ' ошибка
               CurrentStep = i
               Exit For
            End If
         Case 1
            ' Создать Handle
            h = CreateEvent(NULL, TRUE, FALSE, NULL)
            
            If h = NULL Then
               ' ошибка
               CurrentStep = i
               Exit For
            End If
         Case 2
            ' создать окно
            w = CreateWindowEx(...)
            
            If w = NULL Then
               ' ошибка
               CurrentStep = i
               Exit For
            End If
         Case 3
            ' создать файл
            f = CreateFile(...)
            
            If f = INVALID_HANDLE_VALUE Then
               ' ошибка
               CurrentStep = i
               Exit For
            End If
         Case Else
            ' Инициализация пройдена
            ' возвращаем успех
            Return True
      End Select
   Next

   ' Очистка в обратном порядке:
   For i As Integer = CurrentStep - 1 To 0 Step -1
      Select Case i
         Case 2
            ' удалить окно
            DestroyWindow(w)
         Case 1
            ' Удалить HANDLE
            CloseHandle(h)
         Case 0
            ' Уничтожить память
            Deallocate(p)
      End Select
   Next

   ' Ошибка
   Return False

End Function