![]() |
[TCP] Bilderstreaming
Alsoooo ......,
den ganzen Tag sitze ich hier schon dran, habe alle Threads in denen TCP Webcam/Bilder/Dateien drinvorkommen mindestens 3x gelesen und trotzdem verzweifel ich. Vorweg erstmal. Ich wollte anfangs das Webcam-Streamgin mit IdVCLSteam machen, doch das kannte mein D7 PE mit Indy 10 nicht. Also hab ich ein bisschen improvisiert und ich glaube da fehlt mir einiges bei den Streamingbefehlen, da Delphi auch kein OpenWriteBuffer oder so ähnlich kannte. Hier mal mein Codesalat. :D
Delphi-Quellcode:
Ich hoffe mal ich habe das gut genug auskommentiert um da durchzublicken. Da das eine meiner ersten Anwendungen mit TCP & Co ist, habe ich das in euren Augen wahrscheinlich viel zu umständlich gelöst, z.B. die Connecting-Versuche im Timer1, solange bis es geklappt hat. :D
unit Main;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, IdIPWatch, IdTCPClient, IdTCPServer, Dialogs, ShellAPI, StdCtrls, ExtCtrls, Clipbrd, Math, IdComponent, Forms, JPEG, IdTCPConnection, IdCustomTCPServer, IdBaseComponent, IdContext; type TfrmMain = class(TForm) TCPClient: TIdTCPClient; Timer1: TTimer; Timer2: TTimer; Panel1: TPanel; TCPServer: TIdTCPServer; procedure Timer1Timer(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormCreate(Sender: TObject); procedure TCPServerExecute(AContext: TIdContext); private Handle: THandle; { Private declarations } public { Public declarations } end; var frmMain: TfrmMain; Status, Diff: Boolean; NEW_BMP, OLD_BMP, BUFFER_BMP: TBitmap; JPG: TJpegImage; const WM_CAP_DRIVER_CONNECT = WM_USER + 10; WM_CAP_EDIT_COPY = WM_USER + 30; WM_CAP_SET_PREVIEW = WM_USER + 50; WM_CAP_SET_OVERLAY = WM_USER + 51; WM_CAP_SET_PREVIEWRATE = WM_USER + 52; implementation {$R *.dfm} //Berechnen der Farbunterschiede für eine bessere Bildrate procedure GetDifference(ZielDC,DC1,DC2:HDC;DCwidth:integer;DCheight:integer); begin BitBlt(ZielDC, 0, 0, DCWidth, DCHeight, DC2, 0, 0, SRCCOPY); bitblt(ZielDC, 0, 0, DCWidth, DCHeight, DC1, 0, 0, SRCINVERT); end; //Notwendige Funktion zum Zugriff auf die Webcam function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hwndParent: HWND; nID: Integer): HWND; stdcall; external 'AVICAP32.DLL' name 'capCreateCaptureWindowA'; //Sucht solange den Server bis er ihn gefunden hat //Soll später außerhalb des Netzwerkes laufen. //Abfangen von Fehlermeldungen, wenn der Server //nicht on ist; Reconnecten bis zum Erfolg procedure TfrmMain.Timer1Timer(Sender: TObject); begin If Status = False then begin TCPClient.Host:= '127.0.0.1'; Try TCPClient.Connect; Except end; Try If TCPClient.IOHandler.ReadLn = 'Connecting to Client ...' then Status := True; Except Status := False; end; end; //Abschalten -und Anschalten der Webcamanzeige //und des Streames wenn (keine) Verbindung steht. If (Status = True ) and (Timer2.Enabled = False) then Timer2.Enabled := True; If (Status = False) and (Timer2.Enabled = True ) then Timer2.Enabled := False; end; procedure TfrmMain.FormCreate(Sender: TObject); begin //Initialisierung Status := False; Diff := False; NEW_BMP := TBitmap.Create; OLD_BMP := TBitmap.Create; BUFFER_BMP := TBitmap.Create; JPG := TJPEGImage.Create; JPG.CompressionQuality := 100; //Webcam anzeigen Handle := capCreateCaptureWindow('Video', ws_child + ws_visible, 0, 0, 640, 480, Panel1.Handle, 1); SendMessage(Handle, WM_CAP_DRIVER_CONNECT, 0, 0); SendMessage(Handle, WM_CAP_SET_PREVIEWRATE, 15, 0); SendMessage(Handle, WM_CAP_SET_OVERLAY, 1, 0); SendMessage(Handle, WM_CAP_SET_PREVIEW, 1, 0); end; procedure TfrmMain.Timer2Timer(Sender: TObject); var Datei: textFile; S: TMemoryStream; begin //Kopieren des Webcam-Bildes SendMessage(Handle, WM_CAP_EDIT_COPY, 1, 0); //Wenn es das 1. Bild ist, kann kein Unterschied berechnet werden ... If Diff = False then begin NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0); JPG.Assign(NEW_BMP); Diff := True; end //Wenn es aber schon mind. das 2 ist, kann der Unterschied berechnet werden. Else begin OLD_BMP.Assign(NEW_BMP); NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0); BUFFER_BMP.Width := Min(OLD_BMP.Width, NEW_BMP.Width); BUFFER_BMP.Height := Min(OLD_BMP.height, NEW_BMP.height); GetDifference(BUFFER_BMP.Canvas.Handle, OLD_BMP.Canvas.Handle, NEW_BMP.Canvas.Handle, BUFFER_BMP.Width, BUFFER_BMP.Height); JPG.CompressionQuality := 100; JPG.Assign(BUFFER_BMP); end; //Versuche Stream-Verschicken Try S := TMemoryStream.Create; TCPClient.IOHandler.Write(S); FreeAndNil(S); Except ShowMessage('Fehler: Stream konnte nicht verschickt werden.'); end; end; procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin //Freigeben OLD_BMP.Free; NEW_BMP.Free; BUFFER_BMP.Free; JPG.Free; end; procedure TfrmMain.TCPServerExecute(AContext: TIdContext); var connected: boolean; S: TMemoryStream; begin //"Willkommensmeldung" zur Kontrolle, ob Verbindung zum Clienten steht AContext.Connection.IOHandler.WriteLn('Connecting to Client ...'); connected := true; S := TMemoryStream.Create; while connected do begin try //Versuche Stream zu empfangen AContext.Connection.IOHandler.ReadStream(S); JPG := TJPEGImage.Create; JPG.LoadFromStream(S); Windows.Beep(1000,2000); JPG.SaveToFile('temp.jpg'); JPG.Free; except ShowMessage('Fehler: Stream konnte nicht verschickt werden.'); end; end; FreeAndNil(S); end; end. Ich bin mir ganz sicher, dass das Problem beim Streamen liegt, weil er da gar nichts macht. Hoffe ihr könnt mir ein bisschen Licht ins Dunkeln bringen, welche Befehle falsch sind / fehlen. Mist! Ich wusste doch, ich hatte noch etwas vergessen. :D Und zwar habe ich der Einfachheit halber den clienten und den Server in eine EXE gepackt. Dürfte dem PC / Delphi eigentlich egal sein. TCPServer habe ich bereits im OI auf Active = True gestellt. |
Re: [TCP] Bilderstreaming
Huch? Noch keine Antwort? Habe ich mich zu unverständlich ausgedrückt? :lol:
|
Re: [TCP] Bilderstreaming
Moin Christopher,
du hast dir zwar durchaus Mühe gegeben, aber von einer guten Problembeschreibung bist du doch noch meilenweit entfernt. Welcher Code ist schon getestet und funktioniert zuverlässig? Treten Fehler auf? An welcher Stelle verhält sich dein Code anders als du es erwartest?
Delphi-Quellcode:
Warum willst du hier einen leeren Stream verschicken?
// ...
//Versuche Stream-Verschicken Try S := TMemoryStream.Create; TCPClient.IOHandler.Write(S); FreeAndNil(S); Except ShowMessage('Fehler: Stream konnte nicht verschickt werden.'); end; // ... Variablen, die nicht unbedingt benötigt werden, solltest du garnicht erst deklarieren. Werden sie benötigt, dann deklariere sie lokal zur Methode, in der sie benötigt werden. Greifen mehrere Methoden auf die Variablen zu, so deklariere sie im private-Abschnit der Form. Sie sind dann automatisch initialisiert. Deaktiviere Timer für die Daier der Ereignisbehandlung, wenn du sicher sein willst, dass kein Mehrfacheintritt vorkommt. Grüße vom marabu |
Re: [TCP] Bilderstreaming
Ups. :lol:
Der Fehler ist mir gar nicht aufgefallen. Dann versuche ich es jetzt noch ein bisschen deutlicher zu beschreiben: Ich verschicke den Stream:
Delphi-Quellcode:
Keine Fehlermeldung und JPG enthält ein richtiges Bild.
Try
S := TMemoryStream.Create; JPG.SaveToStream(S); TCPClient.IOHandler.Write(S); FreeAndNil(S); Except ShowMessage('Fehler: SendStream'); end; Ich empfange den Stream:
Delphi-Quellcode:
Zwar ist der DualCore bei 100 % Auslastung, aber passieren tut nichts. Weder ein Windows-Signalton, noch eine Fehlermeldung.
//"Willkommensmeldung" zur Kontrolle, ob Verbindung zum Clienten steht
AContext.Connection.IOHandler.WriteLn('Connecting to Client ...'); connected := true; S := TMemoryStream.Create; while connected do begin try //Versuche Stream zu empfangen AContext.Connection.IOHandler.ReadStream(S); JPG := TJPEGImage.Create; JPG.LoadFromStream(S); Windows.Beep(1000,2000); JPG.SaveToFile('temp.jpg'); JPG.Free; except ShowMessage('Fehler: GetStream'); end; end; FreeAndNil(S); Ich würde ja gerne mal mit Breakpoint testen, doch beim Compilieren kommt gleich: Zitat:
Aber diese Fehlermeldung hab ich eigentlich immer bei den Indys, aber nicht, wenn ich die kompilierte EXE aufrufe, da meckert er dann komischerweise nicht. Imho hat die Fehlermeldung nichts damit zu tun. Mache ich ein neues Projekt mit TCPClient aus der neuesten Indysammlung auf die Form, schreibe ins FormCreate TCPClient.Host := '127.0.0.1';, kommt beim Kompilieren der selbe Fehler, aber nicht später in der EXE. |
Re: [TCP] Bilderstreaming
Bevor du den Inhalt eines Stream versenden kannst, musst du in der Regel die Position auf 0 setzen.
Zuerst aber solltest du testen, ob und unter welchen Umständen deine Testumgebung (Client und Server im selben Lademodul) überhaupt funktionieren kann. Hat der Server überhaupt die Gelegenheit Pakete anzunehmen, während der Client 128KByte Bilddaten rausschickt, der TCP-Buffer aber nur 16KByte (alles nur Beispielangaben) groß ist? |
Re: [TCP] Bilderstreaming
Hi,
probiere es mal so: Beispiel Senden:
Delphi-Quellcode:
Dabei wird zunächst mit SendText ein Header geschrieben, anschließend wird mit SendBuf das Bild übertragen. Die Anweisung Sleep verhindert, dass der Text und der Anfang der Daten zu einem Paket zusammengefasst werden – dann hätte der Client nämlich Probleme, sie wieder auseinander zu bekommen.// ... FStream := TMemoryStream.Create; try FBitmap.SaveToStream(FStream); Buf := FStream.Memory; with ServerSocket1.Socket do begin for i := 0 to ActiveConnections - 1 do begin Connections[i].SendText('Daten' + IntToStr(FStream.Size)); Sleep(50); Connections[i].SendBuf(Buf^, FStream.Size); end; {for i := 0 to ActiveConnections do} end; {with ServerSocket1.Socket do} finally FStream.Free; end; Empfang:
Delphi-Quellcode:
Alle eintreffenden Daten werden nach FStream geschrieben. Sobald FPos gleich FSize ist, sind alle Daten eingetroffen. FDaten wird wieder auf false gesetzt und das
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket); var a: array array[0..4096] of Byte; i: integer; s: string string; begin if FDaten = false then begin s := Socket.ReceiveText; if Copy(s, 1, 5) = 'Daten' then begin Delete(s, 1, 5); try FSize := StrToInt(s); FDaten := true; Image1.Picture.Bitmap := nil nil; FStream.Clear; except end; end; {if Copy(s, 1, 5) = 'Daten' then} end {if FDaten = false then} else begin i := Socket.ReceiveBuf(a, 4096); FStream.Write(a, i); FPos := FPos + i; if FPos >= FSize then begin FDaten := false; FStream.Position := 0; FPos := 0; Image1.Picture.Bitmap.LoadFromStream(FStream); end; end; {else FDaten = false then} Bitmap aus dem Stream nach Image1 geladen. Mfg Net7 |
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:24 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz