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:
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 Dieser Tipp wurde bereits 19.767 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |