Bildversand aus der PictureBox Hier wird gezeigt, wie man ein Bild fehlerfrei direkt aus einer Picturebox via Winsock versenden kann.
Autor:   Lars Schoening	Bewertung:     [ Jetzt bewerten ]	Views:  19.749
newdarkness.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 16 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.2 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Wie man ein Bild versenden kann ist ja klar: Abspeichern und die Datei via Winsock-Control versenden.

Was aber, wenn man das Bild direkt ohne es vorher abzuspeichern versenden möchte?

Hierzu muss das Bild erstmal in eine Variable umgewandelt werden - und das geht mit Hilfe des PropertyBag-Objekts der PictureBox. Dann müssen große Bilder aber auch gechunked werden, d.h. "häppchenweise" versandt werden, da sonst Daten verloren gehen können.

Im nachfolgenden möchten wir Ihnen zeigen, wie sich ein vorhandes Bild direkt aus einer PictureBox via Winsock versenden lässt. Hierbei wird das Bild in gleich großen Datenpaketen versandt (40x40 Pixel). Die Gegenstelle bekommt die Daten also "häppchenweise" geliefert und baut die einzelnen Bildausschnitte wieder korrekt zu einem Gesamtbild zusammen.

Erstellen Sie ein neues Projekt und platzieren folgende Controls auf die Form:

• 2 x PictureBox (Picture1 und Picture2 mit AutoSize = True, AutoRedraw = True und ScaleMode = vbPixels)
• 1 x CommandButton (Command1)
• 2 x ProgressBar (ProgressBar1 und ProgressBar2)
• 2 x Winsock-Control (Winsock1 und Winsock2)

Laden Sie ein beliebiges Bild in die 1. PictureBox (Picture1). Beim Klick auf den CommandButton soll dann das Bild via Winsock versandt werden. In unserem Beispiel wird das Bild dann direkt in der 2. PictureBox angezeigt.

Option Explicit
 
' Rückwerte
Public BackMessage As Boolean
Public ErrorMessage As Boolean
 
' Größe des Bildausschnitts
' Achtung! Bei Werten über 40 gibt's verstärkt Fehlermeldungen
' Dennoch - je größer: je schneller
Const PieceSize = 40
 
' Timeout in Millisekunden
' kann ruhig klein sein, verursacht nur
' wiederholtes Senden
Const Timeout = 500
 
' Zeit In Millisekunden
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
 
' Zum Kopieren von Bildteilen
Private Declare Function BitBlt Lib "gdi32" ( _
  ByVal hDestDC As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hSrcDC As Long, _
  ByVal xSrc As Long, _
  ByVal ySrc As Long, _
  ByVal dwRop As Long) As Long

Private Sub Command1_Click()
  Dim x As Long
  Dim y As Long
  Dim Prozentzahl As Long
  Dim TimeBefore As Single
  Dim NoError As Boolean
 
  ' Verbinden
  With Winsock1
    .Close
    .LocalPort = 123
    .Listen
 
    Winsock2.Connect .LocalIP, 123
 
    ' Warten Bis Verbindung Aufgebaut
    Do
      DoEvents
    Loop Until Winsock2.State = 7 Or Winsock2.State = 9
 
    ' Wenn Verbindung aufgebaut
    If Winsock2.State = 7 Then
      ' Alle Bildstücke "häppchenweise" senden
      For x = 1 To Picture1.ScaleWidth Step PieceSize
        ' Fortschritt
        Prozentzahl = Round(100 * ((x - 1) + PieceSize) / Picture1.ScaleWidth)
        If Prozentzahl > 100 Then Prozentzahl = 100
        For y = 1 To Picture1.ScaleHeight Step PieceSize
          Do
            ' Rücknachricht zurücksetzen
            BackMessage = False
            TimeBefore = MilliTime
 
            ' Wichtigster Teil - Bild Senden
            NoError = SendImage(Me, x, y, PieceSize, Winsock2, Picture1, Prozentzahl)
 
            ' Bei Socketfehler: Alarm schlagen
            If NoError = False Then
              MsgBox "Fehler!" & vbCrLf & "Verbindung wurde unterbrochen", vbCritical
              Exit Do
            End If
 
            ' Wichtig! Auf Reaktion warten, Fehler oder Timeout
            Do
              If TimeBefore - MilliTime > Timeout Then
                ErrorMessage = True
                BackMessage = True
              End If
 
              If Winsock2.State <> 7 Then
                MsgBox "Fehler!" & vbCrLf & "Verbindung wurde unterbrochen", vbCritical
                Exit Do
              End If
 
              DoEvents
            Loop Until BackMessage = True
 
            ' Fortschritt anzeigen
            ProgressBar1.Value = Prozentzahl
 
            ' Schleife verlassen, falls alles OK
            If Not ErrorMessage Then Exit Do
          Loop
        Next
      Next
    Else
      ' Sonst Fehler
      MsgBox "Fehler!" & vbCrLf & "Verbindung konnte nicht hergestellt werden", vbCritical
    End If
  End With
 
  ' Socket schließen
  Winsock1.Close
  Winsock2.Close
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
  ' Verbindung herstellen
  Winsock1.Close
  Winsock1.Accept requestID
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  Dim ImagePack As New PropertyBag
  Dim RecievedImage As Variant
  Dim oTemp As Object
 
  ' Bei Fehler Sendevorgang wiederholen
  On Error GoTo ImageError
 
  ' Daten holen
  Winsock1.GetData RecievedImage
 
  ' Temporäre Picturebox erstellen
  Set oTemp = Me.Controls.Add("VB.PictureBox", "TemporaryPictureBox")
  With oTemp
    .AutoRedraw = True
    .AutoSize = True
     .BorderStyle = 0
   End With
 
  ' Inhalt ins PeopertyBag der PictureBox speichern
  With ImagePack
    ' Inhalt Laden: Bei Fehler durch falsche Daten wird
    ' der Snedevorgang wiederholt
    .Contents = RecievedImage
 
    ' Bild aus PropertyBag laden...
    oTemp.Picture = .ReadProperty("Picture", Nothing)
 
    ' ...und in der echten PictureBox anzeigen
    Picture2.PaintPicture oTemp.Picture, .ReadProperty("X", 0), .ReadProperty("Y", 0)
 
    ' temporäre PictureBox wieder entfernen
    Me.Controls.Remove "TemporaryPictureBox"
 
    ' Fortschritt anzeigen
    ProgressBar2.Value = .ReadProperty("Percent", 0)
  End With
 
  ' Rückmeldung: OK (autom. Anfordern des nächsten Bildteils)
  Winsock1.SendData "OK"
  Exit Sub
 
ImageError:
  ' Rückgabewert "Fehler": Sendevorgang wiederholen
  Winsock1.SendData "ERROR"
End Sub

' Rückmeldung auswerten
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
  Dim RecievedData As String
 
  Winsock2.GetData RecievedData
  Select Case RecievedData
    Case Is = "OK"
      ErrorMessage = False
      BackMessage = True
    Case Is = "ERROR"
      ErrorMessage = True
      BackMessage = True
  End Select
End Sub

Function SendImage(ParentForm As Form, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal Size As Long, _
  Socket As Winsock, _
  Picture As PictureBox, _
  ByVal Percent As Long) As Boolean
 
  Dim ImageData As Variant
  Dim ImagePack As New PropertyBag
  Dim oTemp As Object
 
  ' temporäre Picturebox erstellen
  Set oTemp = ParentForm.Controls.Add("VB.PictureBox", _
    "TemporaryPictureBox_SENDING")
 
  ' Bildausschnitt kopieren
  With oTemp
    .ScaleMode = vbPixels
    .Width = ParentForm.ScaleX(Size, vbPixels, ParentForm.ScaleMode)
    .Height = ParentForm.ScaleY(Size, vbPixels, ParentForm.ScaleMode)
    .AutoRedraw = True
    .BorderStyle = 0
 
    BitBlt .hDC, 0, 0, Size, Size, Picture.hDC, x, y, vbSrcCopy
  End With
 
  ' Daten ins PropertyBag speichern
  With ImagePack
    .WriteProperty "Picture", oTemp.Image, Nothing
    .WriteProperty "Size", Size
    .WriteProperty "Percent", Percent
    .WriteProperty "X", x
    .WriteProperty "Y", y
    ImageData = .Contents
  End With
 
  ' temporäre PictureBox wieder entfernen
  ParentForm.Controls.Remove "TemporaryPictureBox_SENDING"
 
  ' Bildausschnitt senden, falls gültiger Socket vorhanden
  If Socket.State = 7 Then
    Socket.SendData ImageData
    SendImage = True
    DoEvents
  Else
    SendImage = False
  End If
End Function

Function MilliTime()
  MilliTime = timeGetTime
End Function