Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Webcam-Bilder im gfx-Screeen
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  Volta |  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 | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen