Tipp 0273 Video-Capture mit Visual Basic
Autor/Einsender:
Datum:
  Christian Lotmann
26.09.2002
Entwicklungsumgebung:   VB 5
Zwischenzeitlich gehören eine Web-Cam oder eine TV-Karte schon zur PC-Grundausstattung. Natürlich lassen sich die Möglichkeiten dieser Komponenten mit VB ansprechen, und dieser Tipp zeigt, wie dies mittels einiger API-Funktionen und ganz ohne zusätzliche OCX möglich ist.
Die Ansteuerung erfolgt nur über die Windows-API und den Treibern der entsprechenden Hardware. So ist es möglich, jede Videoquelle wie TV-Karte, Web-Cam oder Camcorder am Videoeingang anzusprechen.
Das Download-Beispiel ist ausführlich dokumentiert.
Code im Codebereich des Moduls
 
Option Explicit

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd _
      As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
      ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
      ByVal wFlags As Long) As Long

Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const HWND_BOTTOM = 1
Public Const WM_USER = &H400

Type POINTAPI
  x As Long
  y As Long
End Type

Public Declare Function SendMessage Lib "user32" Alias _
      "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Integer, ByVal lParam As Long) As Long

Public Const WM_CAP_START = WM_USER

Public Const WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2
Public Const WM_CAP_SET_CALLBACK_STATUS = WM_CAP_START + 3
Public Const WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4
Public Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
Public Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6
Public Const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_CAP_START + 7

Public Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14

Public Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
Public Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Public Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43

Public Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Public Const WM_CAP_GET_STATUS = WM_CAP_START + 54

Public Const WM_CAP_SET_CALLBACK_CAPCONTROL = WM_CAP_START + 85

Type CAPDRIVERCAPS
  wDeviceIndex As Long
  fHasOverlay As Long
  fHasDlgVideoSource As Long
  fHasDlgVideoFormat As Long
  fHasDlgVideoDisplay As Long
  fCaptureInitialized As Long
  fDriverSuppliesPalettes As Long
  hVideoIn As Long
  hVideoOut As Long
  hVideoExtIn As Long
  hVideoExtOut As Long
End Type

Type CAPSTATUS
  uiImageWidth As Long
  uiImageHeight As Long
  fLiveWindow As Long
  fOverlayWindow As Long
  fScale As Long
  ptScroll As POINTAPI
  fUsingDefaultPalette As Long
  fAudioHardware As Long
  fCapFileExists As Long
  dwCurrentVideoFrame As Long
  dwCurrentVideoFramesDropped As Long
  dwCurrentWaveSamples As Long
  dwCurrentTimeElapsedMS As Long
  hPalCurrent As Long
  fCapturingNow As Long
  dwReturn As Long
  wNumVideoAllocated As Long
  wNumAudioAllocated As Long
End Type

Declare Function capCreateCaptureWindowA Lib "avicap32.dll" ( _
      ByVal lpszWindowName As String, ByVal dwStyle As Long, _
      ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
      ByVal nHeight As Integer, ByVal hWndParent As Long, _
      ByVal nID As Long) As Long

Declare Function capGetDriverDescriptionA Lib "avicap32.dll" ( _
      ByVal wDriver As Integer, ByVal lpszName As String, _
      ByVal cbName As Long, ByVal lpszVer As String, _
      ByVal cbVer As Long) As Boolean

Function capDriverConnect(ByVal lwnd As Long, _
      ByVal i As Integer) As Boolean
  capDriverConnect = _
    SendMessage(lwnd, WM_CAP_DRIVER_CONNECT, i, 0)
End Function

Function capDriverGetCaps(ByVal lwnd As Long, ByVal s As Long, _
      ByVal wSize As Integer) As Boolean
  capDriverGetCaps = _
    SendMessage(lwnd, WM_CAP_DRIVER_GET_CAPS, wSize, s)
End Function

Function capGetStatus(ByVal lwnd As Long, ByVal s As Long, _
      ByVal wSize As Integer) As Boolean
  capGetStatus = SendMessage(lwnd, WM_CAP_GET_STATUS, wSize, s)
End Function

Function capDlgVideoFormat(ByVal lwnd As Long) As Boolean
  capDlgVideoFormat = _
    SendMessage(lwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
End Function

Function capDlgVideoSource(ByVal lwnd As Long) As Boolean
  capDlgVideoSource = _
    SendMessage(lwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0)
End Function

Function capDlgVideoDisplay(ByVal lwnd As Long) As Boolean
  capDlgVideoDisplay = _
    SendMessage(lwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0)
End Function

Function capPreview(ByVal lwnd As Long, ByVal f As Boolean) _
      As Boolean
  capPreview = SendMessage(lwnd, WM_CAP_SET_PREVIEW, f, 0)
End Function

Function capPreviewRate(ByVal lwnd As Long, _
      ByVal wMS As Integer) As Boolean
  capPreviewRate = _
    SendMessage(lwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0)
End Function

Function capSetCallbackOnError(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnError = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_ERROR, 0, lpProc)
End Function

Function capSetCallbackOnStatus(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnStatus = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_STATUS, 0, lpProc)
End Function

Function capSetCallbackOnYield(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnYield = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_YIELD, 0, lpProc)
End Function

Function capSetCallbackOnFrame(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnFrame = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_FRAME, 0, lpProc)
End Function

Function capSetCallbackOnVideoStream(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnVideoStream = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, lpProc)
End Function

Function capSetCallbackOnWaveStream(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnWaveStream = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, lpProc)
End Function

Function capSetCallbackOnCapControl(ByVal lwnd As Long, _
      ByVal lpProc As Long) As Boolean
  capSetCallbackOnCapControl = _
    SendMessage(lwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, lpProc)
End Function
 
Code im Codebereich der Form
 
Option Explicit

Dim lwndC As Long

Private Sub Form_Load()
  Dim lpszName As String * 100
  Dim lpszVer As String * 100
  Dim Caps As CAPDRIVERCAPS

  capGetDriverDescriptionA 0, lpszName, 100, lpszVer, 100
  lwndC = capCreateCaptureWindowA(lpszName, _
        WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, Me.hwnd, 0)

  capDriverConnect lwndC, 0
  capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)

  If Caps.fHasDlgVideoSource = 0 Then mnuSource.Enabled = False
  If Caps.fHasDlgVideoFormat = 0 Then mnuFormat.Enabled = False
  If Caps.fHasDlgVideoDisplay = 0 Then mnuDisplay.Enabled = False

  capPreviewRate lwndC, 66
  capPreview lwndC, True
  ResizeCaptureWindow lwndC
End Sub

Private Sub ResizeCaptureWindow(ByVal lwnd As Long)
  Dim CAPSTATUS As CAPSTATUS

  capGetStatus lwnd, VarPtr(CAPSTATUS), Len(CAPSTATUS)

  SetWindowPos lwnd, HWND_BOTTOM, 0, 0, _
                     CAPSTATUS.uiImageWidth, _
                     CAPSTATUS.uiImageHeight, _
                     SWP_NOMOVE Or SWP_NOZORDER
End Sub

Private Sub mnuDisplay_Click()
  capDlgVideoDisplay lwndC
End Sub

Private Sub mnuFormat_Click()
  capDlgVideoFormat lwndC
  ResizeCaptureWindow lwndC
End Sub

Private Sub mnuSource_Click()
  capDlgVideoSource lwndC
End Sub

Private Sub mnuPreview_Click()
  mnuPreview.Checked = Not (mnuPreview.Checked)
  capPreview lwndC, mnuPreview.Checked
End Sub

Private Sub Form_Unload(Cancel As Integer)
  capSetCallbackOnError lwndC, vbNull
  capSetCallbackOnStatus lwndC, vbNull
  capSetCallbackOnYield lwndC, vbNull
  capSetCallbackOnFrame lwndC, vbNull
  capSetCallbackOnVideoStream lwndC, vbNull
  capSetCallbackOnWaveStream lwndC, vbNull
  capSetCallbackOnCapControl lwndC, vbNull
End Sub
 
Weitere Links zum Thema
AVI-& MPEG-Dateien ohne Control abspielen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (7,4 kB) Downloads bisher: [ 11274 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 7. September 2011