Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Multimedia

Webcam-Bilder im gfx-Screeen

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.RedakteurVolta 25.02.2009
' 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

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 06.01.2009 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 25.02.2009 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen