Probleme mit der Webcam Steuerung

E

edmached

Grünschnabel
Hallo zusammen,

ich habe hier ein Problem, wobei ihr mir hoffentlich weiter helfen kann.

Habe ein Programm um ein Webcam anzusteuern.
Das Vedeio wird auf einer PictureBox angezeigt.
Per Tastendruck oder durch ein Signal vom Netzwerk,
soll die Webcam ein Foto schiessen und diese in .jpg speichern.
Alles klappt auch wunderbar.
Nun das Problem:
Sobald ein Fenster, welches auch immer, die PictureBox verdeckt, schiesst/speichert die kamera nur das letzte von ihm gesehende Bild bevor es verdeckt wurde, und nicht die aktuelle.:confused:
Das Problem tritt auch auf, wenn die Form minimiert wird, dann schiesst/speichert es auch nur das vom ihn zuletzt gesehen, bevor es minimiert wurde.

Ich hoffe das ich euch mein Problem genau schildern konnte.
Weiss jemand wie ich diesen Fehler beheben kann

Vielen Dank im voraus.

Mein Code sieht foldenermaßen aus:
die Form
PHP: 
Option Explicit

Const AW_HIDE = &H10000
Const AW_BLEND = &H80000
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean
Dim g_Video_Handle As Long


Private Sub Form_Load()
    Dim iport As Integer
    Connect
    'iport = 10010   'Port definieren
    'Picture1.Visible = False
    'Livebild starten und im Fenster anzeien
    g_Video_Handle = CreateCaptureWindow(VideoBild.hwnd)
        
End Sub

Private Sub Connect()
    Dim iport As Integer
    iport = 10010   'Port definieren
    'Horchen starten
    'Winsock1.Protocol = sckTCPProtocol
    'Winsock1.LocalIP = "127.0.0.1"
    Winsock1.Close
    Winsock1.LocalPort = iport
    Winsock1.Listen
End Sub

Private Sub Winsock1_Close()
    Connect
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Verbindung zur Kamera schließen
    Disconnect (g_Video_Handle)
    'Das Abhören wird beendet
    Winsock1.Close
    'Kleine Animation beim Beenden
    AnimateWindow Me.hwnd, 500, AW_HIDE Or AW_BLEND
End Sub

Private Sub Save_Click()
    Dim sFilename As String
    'Dateinamen definieren
    sFilename = "Testbild"
    sFilename = AddExtension(sFilename)
    MakeAbsPath (sFilename)
    'Foto schießen und in Picture1 zwischenspeichern
    CapturePicture g_Video_Handle, Picture1
    'Foto von Picture1 holen und speichern
    Save_JPG Picture1, sFilename
End Sub

Private Sub Beenden_Click()
    Unload Me
End Sub

Private Sub Timer1_Timer()
    Dim sMessage As String
    'lblStatus gibt den Status wieder
    'lblStatus.Caption = Winsock1.State
    Select Case Winsock1.State
        Case 0
            sMessage = "Socket ist geschlossen"
        Case 1
            sMessage = "Socket ist geöffnet"
        Case 2
            sMessage = "Der Socket ist empfangsbereit"
        Case 3
            sMessage = "Die Verbindung wird aufgebaut"
        Case 4
            sMessage = "Der Remote-Host-Name wird in eine IP-Adresse umgewandelt"
        Case 5
            sMessage = "Der Remote-Host-Name wurde in eine IP-Adresse umgewandelt"
        Case 6
            sMessage = "Der Socket verbindet sich zu dem Remote"
        Case 7
            sMessage = "Der Socket hat sich zu dem Remote verbunden"
        Case 8
            sMessage = "Der Remote hat die Verbindung getrennt"
        Case 9
            sMessage = "Ein Fehler ist aufgetreten"
    End Select
    lblStatus.Caption = sMessage
End Sub

'Reaktion des Winsock bei Verbindungsanfrage
Private Sub Winsock1_ConnectionRequest(ByVal requestid As Long)
    Label2.Caption = requestid
    'Das Abhören wird beendet
    Winsock1.Close
    'Die Verbindung wird akzeptiert
    Winsock1.Accept requestid
    
End Sub

'Reaktion des Winsock, wenn Daten empfangen werden
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim sData As String
    'ankommende Daten in sData speichern
    Winsock1.GetData sData
    'sData interpretieren
    InterpretData sData
End Sub

'Daten interpretieren
Private Sub InterpretData(ByVal sData As String)
    Dim sFilename As String
    Dim sCommand_Shot, sCommand_Save As String
    'Codenummer für Befehle definieren
    sCommand_Shot = "1"
    sCommand_Save = "2"
    'Entscheidung, welcher Befehl versendet wurde...
    '...und entsprechende Reaktion
    If Left$(sData, 1) = sCommand_Shot Then
        FotoSchiessen
    ElseIf Left$(sData, 1) = sCommand_Save Then
        sFilename = GetFilename(sData)
        sFilename = AddExtension(sFilename)
        sFilename = MakeAbsPath(sFilename)
        FotoSpeichern (sFilename)
    End If
End Sub

'absolute Pfadangabe vor den Dateinamen schreiben
Private Function MakeAbsPath(ByRef sFilename As String)
    Dim sFile As String
    Dim sPath As String
    sPath = App.Path '?
    If Mid$(sFilename, 2, 1) <> ":" Then
        sFile = sPath
    End If
    If Right$(sFile, 1) <> "\" Then
        sFile = sFile & "\"
    End If
    sFilename = sFile & sFilename
    MakeAbsPath = sFilename
End Function

'Dateiendung anhängen
Private Function AddExtension(ByRef sFilename As String)
    Dim iLen As Integer
    Dim sExt As String
    iLen = Len(sFilename)
    sExt = ".jpg"
    If Mid$(sFilename, iLen - 3, 1) <> "." Then
        AddExtension = sFilename & sExt
    End If
    If Mid$(sFilename, iLen - 3, 1) = "." Then
        AddExtension = sFilename
    End If
End Function

'Dateinamen aus sData extrahieren
Private Function GetFilename(ByVal sData As String)
    Dim sFilename As String
    Dim iLen As Integer
    iLen = Len(sData)
    sFilename = Right$(sData, iLen - 2)
    GetFilename = sFilename
End Function

Private Sub FotoSpeichern(ByVal sFilename As String)
    Save_JPG Picture1, sFilename
    'SavePicture Picture1, sFilename
End Sub

Private Sub FotoSchiessen()
    CapturePicture g_Video_Handle, Picture1
End Sub

Nun die erste Modul um das Video der webcam auf der PictureBox anzuzeigen:
PHP: 
Option Explicit

'benötigte Deklarationen
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _
    Alias "capCreateCaptureWindowA" ( _
    ByVal lpszWindowName As String, _
    ByVal dwStyle As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hWndParent As Long, _
    ByVal nID As Long) As Long

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = &H400
Private Const WM_CAP_START = &H400
Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)

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

Private Preview_handle As Long

Public Function CreateCaptureWindow( _
    hWndParent As Long, _
    Optional x As Long = 0, _
    Optional y As Long = 0, _
    Optional nWidth As Long = 320, _
    Optional nHeight As Long = 240, _
    Optional nCameraID As Long = 0) As Long

    Preview_handle = capCreateCaptureWindow("Video", _
        WS_CHILD + WS_VISIBLE, x, y, _
        nWidth, nHeight, hWndParent, 1)

    SendMessage Preview_handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0
    SendMessage Preview_handle, WM_CAP_SET_PREVIEWRATE, 30, 0
    SendMessage Preview_handle, WM_CAP_SET_OVERLAY, 1, 0
    SendMessage Preview_handle, WM_CAP_SET_PREVIEW, 1, 0

    CreateCaptureWindow = Preview_handle
End Function

Public Sub CapturePicture(nCaptureHandle As Long, _
    picCapture As PictureBox)
    Clipboard.Clear
    SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
    picCapture.Picture = Clipboard.GetData
End Sub

Public Sub Disconnect(nCaptureHandle As Long, _
    Optional nCameraID = 0)

    SendMessage nCaptureHandle, WM_CAP_DRIVER_DISCONNECT, _
        nCameraID, 0
End Sub

Modul um das Bild als .jpg zu speichern:
PHP: 
Private Type GdiplusStartupInput
  GdiplusVersion As Long
  DebugEventCallback As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
  GUID As GUID
  NumberOfValues As Long
  type As Long
  Value As Long
End Type

Private Type EncoderParameters
  Count As Long
  Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" ( _
  token As Long, _
  inputbuf As GdiplusStartupInput, _
  Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
  ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
  ByVal hbm As Long, _
  ByVal hpal As Long, _
  Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
  ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
  ByVal Image As Long, _
  ByVal filename As Long, _
  clsidEncoder As GUID, _
  encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" ( _
  ByVal str As Long, _
  id As GUID) As Long
  
Public Sub Save_JPG( _
  ByVal pict As StdPicture, _
  ByVal filename As String, _
  Optional ByVal quality As Byte = 200)

  Dim tSI As GdiplusStartupInput
  Dim lRes As Long
  Dim lGDIP As Long
  Dim lBitmap As Long

  ' GDI+ initalisieren
  tSI.GdiplusVersion = 1
  lRes = GdiplusStartup(lGDIP, tSI)
   
  If lRes = 0 Then
    '  Erstelle GDI+ Bitmap aus dem Image Handler
    lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
   
    If lRes = 0 Then
      Dim tJpgEncoder As GUID
      Dim tParams As EncoderParameters
         
      ' Initialiseren des Encoders
      CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
      
      ' Nun die Parametrierung...
      tParams.Count = 1
      With tParams.Parameter ' Quality
        ' Quality GUID festlegen
        CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
        .NumberOfValues = 1
        .type = 4
        .Value = VarPtr(quality)
      End With
         
      ' Speichern des Bildes
      lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
                             
      ' Zerstören des Bildes
      GdipDisposeImage lBitmap
    End If
      
    ' GDI+ deinitalisieren
    GdiplusShutdown lGDIP
  End If
   
  If lRes Then
    Err.Raise 5, , "Speicherung des Bildes fehlgeschlagen. GDI+ Error:" & lRes
  End If
End Sub
 
Hi,
also ich habe mir deinen Code jetzt nicht so genau durchgeschaut, aber die Schilderung deines Problems, erinnert mich an ein eigenes Prob., welches ich mal hatte. Mein Prob. war damals, dass ich im Hintergrund meine Picbox "fotografieren" wollte. Geht aber nicht, weil Du immer den GrafikDevice (GDC) angeben musst, und der ist vom Desktop abhändig, soll heissen: Schiebst du eine Form über Deine PicBox, wird das Bild nicht mehr aktuallisiert (ist bei "minimierten" Zustand genauso).
Ne Lösung hab ich nicht gefunden, aber vielleicht hillft es Dir dein Problem zu präzisieren.
 
Zuletzt bearbeitet:
Genau das gleiche Problem scheint ich auch zu haben.
Sobald sich etwas über die PictureBox schiebt, wird das Bild nicht mehr aktunalisiert.

Hast du das Problem garnicht lösen können?

Weiss sonst keiner einen Ausweg? :(

Gruß
edmached
 
Ja, es ist auf AutoRedraw = True eingestellt.

Hab am Anfang auch gedacht, das es daran liegen könnte :(

Leider liegt es wohl woanders....

Gruß
edmached
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück