AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

WebCam via Stream senden

Ein Thema von ByTheTime · begonnen am 18. Sep 2012 · letzter Beitrag vom 30. Sep 2012
Antwort Antwort
Seite 1 von 2  1 2   
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#1

WebCam via Stream senden

  Alt 18. Sep 2012, 21:47
Moin DP,
ich habe mir mal hier einen Anreiz geholt, wie ich das Bild einer WebCam via Stream senden könnte, allerdings bleibe ich an einer Stelle hängen (Ich möchte erstmal den Stream beim Server anzeigen lassen, dannach bastel ich weiter...):

Client:
Delphi-Quellcode:
procedure TFormMain.FormActivate(Sender: TObject);
var
  DeviceList: TStringList;
begin
  if fActivated then
    Exit;

  fActivated := true;

  DeviceList := TStringList.Create;
  fVideoImage.GetListOfDevices(DeviceList);

  if not DeviceList.Count < 1 then
  begin
    fVideoImage.VideoStart(DeviceList[0]);
    Timer1.Enabled := true;
  end;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fVideoImage.VideoStop;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  fActivated := false;
  fVideoImage := TVideoImage.Create;
  fVideoImage.SetDisplayCanvas(PaintBox1.Canvas); //Brauche ich das überhaupt? Oder wie kriege ich das Bild dann in die SendStream Prcedure rein?
end;

procedure TFormMain.SendStream(pic: TBitmap);
var
  MStream: TMemoryStream;
  pOutBuf: pointer;
  cbOutSize: integer;
begin
  pOutBuf := nil;
  cbOutSize := 0;

  MStream := TMemoryStream.Create;
  try
    pic.SaveToStream(MStream);
    ZCompress(MStream.memory, MStream.size, pOutBuf, cbOutSize, zcMax);
  finally
    MStream.Free;
  end;

  if (pOutBuf <> nil) and (cbOutSize > 0) then
  begin
    IdTCPClient1.Socket.Write(pOutBuf, cbOutSize, 0);
    FreeMem(pOutBuf);
  end;
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
  //via Timer Einzelbilder senden (1-2 Sek. Intervall)
  SendStream(); //Hier komm ihch nicht weiter! Das soll ja ein Bild in Form von TBitmap übergeben werden, aber wie, bzw. wo nehme ich es her?
end;

Server:
Delphi-Quellcode:

// Kompression

procedure CompressBitmap_Slow(bmp: TBitmap; var Data: string);
var
  ms: TMemoryStream;
  buf: pointer;
  size: integer;
begin
  ms := TMemoryStream.Create;
  bmp.SaveToStream(ms);
  ZCompress(ms.Memory, ms.size, buf, size);
  SetLength(Data, size);
  Move(buf^, Data[1], size);
  FreeMem(buf);
  ms.Free;
end;

procedure CompressBitmap(bmp: TBitmap; var Data: string);
var
  cs: TZCompressionStream;
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  cs := TZCompressionStream.Create(ms, zcDefault);
  bmp.SaveToStream(cs);
  cs.Free;
  SetLength(Data, ms.size);
  Move(ms.Memory^, Data[1], ms.size);
  ms.Free;
end;

procedure UnCompressBitmap(const Data: string; bmp: TBitmap);
var
  ms: TMemoryStream;
  buf: pointer;
  size: integer;
  outsize: integer;
begin
  try
    size := 0;
    outsize := Length(Data) * 3;
    ZDecompress(@Data[1], Length(Data), buf, outsize, size);
  except
    on E: Exception do
    begin
      E.Message := Format('Error Decompressing Buffer (Len = %d):'#13#10'%s',
        [Length(Data), E.Message]);
      raise;
    end;
  end;
  ms := TMemoryStream.Create;
  ms.Write(buf^, outsize);
  FreeMem(buf);
  ms.Position := 0;
  Assert(bmp <> nil);
  bmp.LoadFromStream(ms);
  ms.Free;
end;

{------ MAIN ------}

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  Data: string;
  FStream: TMemoryStream;
  bmp: TBitmap;
begin
  FStream := TMemoryStream.Create;

  try
    AContext.Connection.Socket.ReadStream(FStream);
    FStream.Position := 0;
  finally
    try
      FStream.Read(Data, 1000000);
    finally
      bmp.LoadFromStream(FStream);
      FStream.Free;
    end;
  end;

  UnCompressBitmap(Data, bmp);
  PaintBox1.Canvas.Create(bmp); //Bin mir da nicht sicher, was ist mit data?
end;
Also in der PaintBox bekomme ich ein Bild, also funktioeniert das schonmal, jetzt weiß ich aber nicht was das mit TBitmap bei der SendStream-Procedure auf sich hat

Danke,

Lukas
Lukas
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#2

AW: WebCam via Stream senden

  Alt 18. Sep 2012, 21:56
Das Bild musst du natürlich erst von der Webcam bekommen. Dazu gibt es hier im Forum auch eine schöne Demoanwendung, wie das über DirectX funktioniert. Wenn du allerdings mit deinem Code einen Stream wie z.b. bei Skype erwartest, muss ich dich enttäuschen.

Deine Kompression ist sehr langsam und wird trotzdem nicht ausreichen, um ein flüssiges Video zu erzeugen. Je nach Verbindungsgeschwindigkeit kannst du mit ca. 1 Frame pro Sekunde rechnen. Hab das vor einiger Zeit auch mal ausprobiert gehabt.

Normale Differenzbildverfahren kannst du hier auch nicht ohne weiteres verwenden, da jede Webcam ein normales Bildrauschen erzeugt. Dadurch werden klassische Differenzbildverfahren ohne Toleranz praktisch nutzlos.

Optimalerweise solltest du auf erprobte Verfahren, wie z.b. MPEG Kompression setzen. Ich selbst habe leider keine passende Implementation dafür in Delphi gefunden.
Projekte:
- GitHub (Profil, zyantific)
- zYan Disassembler Engine ( Zydis Online, Zydis GitHub)
  Mit Zitat antworten Zitat
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#3

AW: WebCam via Stream senden

  Alt 18. Sep 2012, 22:21
Das Problem ist garnicht das auslesen, das funktioniert wunderbar. Das mit der KOmpression lasse ich erstmal außen vor, habe da aber auch schon was passendes gefunden (steht sogar beim Client-Code dabei). Mir reicht auch erstmal ein Bild pro Sekunde, auf Skype möchte ich die Messlatte noch nicht setzen Aber bei mir hackts daran, wie ich das Bild, was ich aus der Cam bekomme jetzt in diese Prodedure packe:

Delphi-Quellcode:
procedure TFormMain.SendStream(pic: TBitmap);
var
  MStream: TMemoryStream;
  pOutBuf: pointer;
  cbOutSize: integer;
begin
  pOutBuf := nil;
  cbOutSize := 0;

  MStream := TMemoryStream.Create;
  try
    pic.SaveToStream(MStream);
    ZCompress(MStream.memory, MStream.size, pOutBuf, cbOutSize, zcMax);
  finally
    MStream.Free;
  end;

  if (pOutBuf <> nil) and (cbOutSize > 0) then
  begin
    IdTCPClient1.Socket.Write(pOutBuf, cbOutSize, 0);
    FreeMem(pOutBuf);
  end;
end;

//Aufruf
SendStream(); //Was muss jetzt aber in die "()"? Etwas vom Typ TBitmap, aber wo bekomme ich das nun her, bzw. wie bekomme ich eine Bitmap aus dem Video?
Lukas

Geändert von ByTheTime (18. Sep 2012 um 22:46 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#4

AW: WebCam via Stream senden

  Alt 19. Sep 2012, 07:42
Delphi-Quellcode:
var
 bmp:TBitmap;
begin
    bmp:=TBitmap.Create;
    try
    bmp.Width := 600;
    bmp.Height := 450;
    BitBlt(bmp.Canvas.Handle,0,0,panel1.Width,panel1.Height,Panel1.canvas.handle,0,0,SRCCOPY);
    image1.Picture.Assign(bmp);
    finally
      bmp.Free;
    end;
wobei ich hier
Delphi-Quellcode:
   connect := capCreateCaptureWindow('Kamera',ws_child+ws_visible, 0,
  0, 600, 450, Panel1.Handle, 1);
verwende, bei Deiner Komponente kannst Du gegf. direkt
 fVideoImage.SetDisplayCanvas(MyBitmap.Canvas); verwenden ....

ansonsten BITBLT auf Panintbox1.canvas.handle ...
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
grizzly

Registriert seit: 10. Dez 2004
150 Beiträge
 
Delphi XE4 Professional
 
#5

AW: WebCam via Stream senden

  Alt 19. Sep 2012, 10:04
Hallo!

Mir scheint, Du verwendest meinen DirectX-Port. Der bietet eine Callback Routine an, dann kannst Du Dir den Umweg über die TPaintbox sparen.

Definiere eine Callback-Routine wie folgt:
Delphi-Quellcode:
procedure TForm1.OnNewVideoFrame(Sender : TObject; Width, Height: integer; DataPtr: pointer);
begin
  // Denkbar wäre, hier ein Busy-Flag zu testen und zu setzen.

  // So holst Du das Bitmap direkt ab:
  fVideoImage.GetBitmap(fVideoBitmap); // fVideoBitmap mußt Du Dir halt noch als TBitmap zuvor erzeugen
  // Alternativ kannst Du gleich den übergebenen Pointer verwenden:
  // Der zeigt auf die Bilddaten (in 24bit RGB oder 8bit Grau, falls "Gray8Bit" gesetzt war
  // Die Speichergröße ergibt sich aus Width*Height*3 (bzw. beim Graustufenbild ohne das *3)
  // (Da die Breiten der Videos meist durch 4 teilbar sind, muß man sich nicht darum kümmern,
  // dass bei Bildern die Scanlines auf ein Vielfaches von 4 Bytes aufgefüllt wird)

  // Hier kommt Dein Code rein zum Packen und verschicken...
  // z.B.: (ohne ZCompress zu kennen): ZCompress(MStream.memory, MStream.size, DataPtr^, Width*Height*3, ...
end;
Statt Deinem Code hier:
 fVideoImage.SetDisplayCanvas(PaintBox1.Canvas); //Brauche ich das überhaupt? Oder wie kriege ich das Bild dann in die SendStream Prcedure rein? meldest Du diesen Callback wie folgt an:
fVideoImage.OnNewVideoFrame := OnNewVideoFrame; (Du kannst natürlich die Zuweisung an die Paintbox drinlassen, dann sparst Du Dir das selber-zeichnen.)

Nebenbei:
Der Foreneintrag, auf den Du in Deinem ersten Post verweist, hatte auch das Problem mit dem Packen der Daten. Ich hatte damals schon darauf hingewiesen, dass viele WebCams ihre Daten sowieso schon gepackt schicken, und in meinem Code-Misthaufen entpackt werden, bevor sie als Bitmap weitergereicht werden.
Das wäre natürlich ein Zwischenschritt, den Du rauslassen könntest, und das Entpacken des Videoframes erst auf der Zielseite machst. Aber natürlich: Die Packqualität ist halt wieder abhängig vom Codec, und Du müßtest in meinem Code-Durcheinander eingreifen...


Gruß
Michael
  Mit Zitat antworten Zitat
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#6

AW: WebCam via Stream senden

  Alt 19. Sep 2012, 22:26
Danke an euch, ich versuche es so, das sieht schonmal ganz gut aus
Lukas
  Mit Zitat antworten Zitat
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#7

AW: WebCam via Stream senden

  Alt 19. Sep 2012, 22:52
Okay, etwas geht dennoch nicht Hier etwas Code:

Client:

Delphi-Quellcode:
procedure TFormMain.FormActivate(Sender: TObject);
var
  DeviceList: TStringList;
begin
  if fActivated then
    Exit;

  fActivated := true;

  DeviceList := TStringList.Create;
  fVideoImage.GetListOfDevices(DeviceList);

  if not DeviceList.Count < 1 then
  begin
    fVideoImage.VideoStart(DeviceList[0]);
    Timer1.Enabled := true;
  end;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fVideoImage.VideoStop;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  TCPClient.Connect;
  fActivated := false;
  fVideoImage := TVideoImage.Create;
  fVideoBitmap := TBitmap.Create;
  PaintBox1.Align := alClient;
  fVideoImage.SetDisplayCanvas(PaintBox1.Canvas);
  fVideoImage.OnNewVideoFrame := OnNewVideoFrame;
end;

procedure TFormMain.SendStream(pic: TBitmap);
var
  MStream: TMemoryStream;
begin
  MStream := TMemoryStream.Create;

  try
    pic.SaveToStream(MStream);
    MStream.Position := 0;
    try
      TCPClient.Socket.Write(MStream, 0, true);
    except
    end;
  finally
    MStream.Free;
  end;
end;

procedure TFormMain.OnNewVideoFrame(Sender: TObject; Width: integer;
  Height: integer; DataPtr: pointer);
begin
  fVideoImage.GetBitmap(fVideoBitmap);
  SendStream(fVideoBitmap);
  fVideoImage.VideoStop; //Erstmal fehlerfrei nur ein Einzelbild erhalten.
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
  //SendStream(fVideoBitmap);
end;
Server:

Delphi-Quellcode:
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
  Data: string;
  FStream: TMemoryStream;
  bmp: TBitmap;
begin
  FStream := TMemoryStream.Create;

  try
    AContext.Connection.Socket.ReadStream(FStream);
    FStream.Position := 0;
  finally
    try
      FStream.Read(Data, 1000000);
    finally
      //bmp.LoadFromStream(FStream);
      JvImage1.LoadFromStream(FStream);
      FStream.Free;
    end;
  end;
end;
Irgendwo schimmelt der Server immer ab, sobald ein Stream gesendet wird, bleibt das Ding hängen Also da steht dann: "CamServer.exe funktioniert nicht mehr", eine dieser Windows-Fehlermeldungen, also keine Exception im Programm oder so. Und ich weiß nicht genau, wie ich die Bitmap die ich bekomme enzeigen lassen soll, oben ist der Code ohne komprimieren, ich will erstmal ein Bild sehen.

Danke
Lukas
  Mit Zitat antworten Zitat
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#8

AW: WebCam via Stream senden

  Alt 21. Sep 2012, 20:14
Darf ich es vllt. doch noch mal Pushen
Lukas
  Mit Zitat antworten Zitat
grizzly

Registriert seit: 10. Dez 2004
150 Beiträge
 
Delphi XE4 Professional
 
#9

AW: WebCam via Stream senden

  Alt 22. Sep 2012, 10:53
Hi!

Ist das jetzt ein reines Problem der Kommunikation, oder spuckt die WebCam Geschichte mit rein in die Suppe?
Falls der WebCam Zugriff verdächtig ist: Hast Du die Übertragung mal nur mit einem Bitmap versucht, so ganz ohne WebCam etc.?

Gruß
Michael
  Mit Zitat antworten Zitat
ByTheTime

Registriert seit: 24. Sep 2011
Ort: Frankfurt
297 Beiträge
 
Delphi XE2 Architect
 
#10

AW: WebCam via Stream senden

  Alt 22. Sep 2012, 17:58
Nein, irgendeine Bitmap klappt auch nicht, es muss am Server-Code liegen, aber ich weiß nicht wo. Da ich erstmal nur ein Frame übertragen wollte, habe ich natürlich viel kopiert Der Autor des Originalthreads (siehe hier) hat zwar seinen ClientCode gepostet, aber nicht den ServerCode. Erst als es um die Kompression ging, hat er etwas ServerCode gezeigt. Es liegt am StreamRead im Server:

Delphi-Quellcode:
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
  Data: string;
  FStream: TMemoryStream;
  bmp: TBitmap;
begin
  FStream := TMemoryStream.Create;

  try
    AContext.Connection.Socket.ReadStream(FStream);
    FStream.Position := 0;
  finally
    try
      FStream.Read(Data, 1000000); //Hier tritt der Fehler auf. Ich weiß nicht genau, was hier rein muss,
                                   //der Code ist aus dem oben genanntem Thema abgeleitet, an dem Punkt
                                   //ging es aber schon um Kompression, was ich ja erstmal nicht will.
    finally
      //bmp.LoadFromStream(FStream);
      JvImage1.LoadFromStream(FStream);
      FStream.Free;
    end;
  end;
end;
Lukas

Geändert von ByTheTime (22. Sep 2012 um 18:05 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:55 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf