Hallo,
ich möchte meinen
Indy-Chat (basierend auf dem entsprechenden Demo) erweitern, um Bilder einer Webcam an die Clients schicken zu können.
Die Einzelbilder der Cam werden als Bitmaps (capture0.bmp, capture1.bmp usw.)gespeichert und vom TCPServer zur Verfügung gestellt:
Delphi-Quellcode:
procedure TfrmMain.tcpServer1Execute(AThread: TIdPeerThread);
var
s, sCommand, sAction :
string;
fStream : TFileStream;
begin
CS.Enter;
try
s := uppercase(AThread.Connection.ReadLn);
sCommand := copy(s,1,3);
sAction := copy(s,5,100);
if sCommand = '
PIC'
then
begin
if FileExists(ProgDir + '
images\' + sAction)
then
Begin
// open file stream to image requested
fStream := TFileStream.Create(ProgDir + '
images\' +
sAction,fmOpenRead + fmShareDenyNone);
// copy file stream to write stream
AThread.Connection.OpenWriteBuffer;
AThread.Connection.WriteStream(fStream);
AThread.Connection.CloseWriteBuffer;
// free the file stream
FreeAndNil(fStream);
End
else
AThread.Connection.WriteLn('
ERR - Requested file
does not exist');
AThread.Connection.Disconnect;
End
else ...
end;
except
on E :
Exception do
ShowMessage(E.
Message);
End;
CS.Leave;
end;
Der Client fordert dann die einzelnen Bilder an und lädt sie per Timer in ein TImage (VideoOut):
Delphi-Quellcode:
procedure TForm1.ToolButton42Click(Sender: TObject);
begin
try
if ToolButton42.Down
then
begin
ToolButton42.ImageIndex := 20;
ToolButton42.Hint := '
Shut down video-cam';
with IdTCPClient2
do
begin
if connected
then DisConnect;
Host := edServer.text;
Port := sePort.Value +1;
Connect;
end;
Timer2.Enabled := True;
end
else
begin
ToolButton42.ImageIndex := 20;
ToolButton42.Hint := '
Start up video-cam';
Timer2.Enabled := False;
IdTCPClient2.Disconnect;
end;
except
{ If we have a problem then rest things }
ToolButton42.Down := false;
end;
//Timer2.Enabled := false;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
Filename:
string;
ftmpStream : TFileStream;
begin
try
if FileCounter < 1000
then
begin
FileName := '
Capture' + IntToStr(FileCounter) + '
.bmp';
inc(FileCounter);
IdTCPClient2.WriteLn('
PIC:' + Filename);
ftmpStream := TFileStream.Create(ProgDir + '
images\'
+ Filename,fmCreate);
while IdTCPClient2.connected
do
IdTCPClient2.ReadStream(fTmpStream,-1,true);
Application.ProcessMessages;
FreeAndNil(fTmpStream);
VideoOut.Picture.LoadFromFile(ProgDir + '
images\' + Filename);
end;
except
on E :
Exception do
ShowMessage(E.
Message);
end;
end;
Doch leider wird nur immer das erste Bitmap übertragen, danach bricht die Übermittlung ab.
Ich habe in einem anderen Forum mal etwas von asynchronen Netzwerkverbindungen gelesen, kenne mich da aber überhaupt nicht aus, vielleicht liegt ja da der Fehler?