[TCP] Bilderstreaming

[Chrissi91]

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.

Delphi-Quellcode:

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 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.

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. 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.