Sorry, das ich mich so lange nicht gemeldet habe, ich wa rim Urlaub und habe in dieser Zeit den Laptop mal ruhen lassen. Aber hier noch mal das Problem und etwas Code:
Ich kann dem Clienten eine Nachricht senden, das er sich beenden soll. Das klappt auch wunderbar, alle Buttons nehmen den Amfangszustand wieder an und die Lampe an meiner WebCam geht aus. Srücke ich jetzt erneut den Start-Button, geht zwar die WebCam an, allerdings bekomme ich kein Bild. Drücke ich dan den Stop-Button, bleibt mein Server-Programm hängen.
Client:
Delphi-Quellcode:
//Adressen, etc. werden schon beim OnCreate gesetzt!
//Erhält Steuerkommandos vom Server
cmdSTARTCAM:
CamClient.Connect;
cmdSTOPCAM:
try
CamClient.Disconnect;
except
ClientSend(Syntax[cmdCAMMSG].Text + #13 + 'Es ist ein Fehler beim trennen der Verbindung aufgetreten.' + #13);
end;
//Benötiger Code
procedure TfrmMain.CamClientConnected(Sender: TObject);
begin
fActivated := False;
fVideoImage := TVideoImage.Create;
fVideoImage.SetDisplayCanvas(GVideo.Canvas);
CamExecute;
TimerList.Events[4].Enabled := TRUE;
end;
procedure TfrmMain.CamClientDisconnected(Sender: TObject);
begin
TimerList.Events[4].Enabled := False;
fVideoImage.VideoStop;
fVideoImage.Free;
fActivated := TRUE;
UploadProgress := False;
end;
procedure TfrmMain.CamClientWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
UploadProgress := TRUE;
end;
procedure TfrmMain.CamClientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
UploadProgress := False;
end;
procedure TfrmMain.CamExecute;
var
DeviceList: TStringList;
begin
if fActivated then
Exit;
fActivated := TRUE;
DeviceList := TStringList.Create;
fVideoImage.GetListOfDevices(DeviceList);
if not DeviceList.Count < 1 then
fVideoImage.VideoStart(DeviceList[0])
else
ClientSend(Syntax[cmdCAMMSG].Text + #13 +
'Es wurde kein Gerät gefunden!' + #13);
end;
procedure TfrmMain.TimerListEvents4Timer(Sender: TObject);
begin
if CamClient.Connected then
if UploadProgress = False then
CamSend(GVideo.Picture.Bitmap); //Image mit Bild der WebCam
end;
procedure TfrmMain.CamSend(Pic: TBitmap);
var
MStream: TMemoryStream;
begin
MStream := TMemoryStream.Create;
try
Pic.SaveToStream(MStream);
MStream.Position := 0;
try
CamClient.Socket.Write(MStream, 0, TRUE);
except
end;
finally
MStream.Free;
end;
end;
Server:
Delphi-Quellcode:
procedure TfrmCam.CamStop;
begin
BtnStop.Enabled := false;
frmMain.ClientSend(Syntax[cmdSTOPCAM].Text + #13);
delay(500); //Sichergehen, dass das Kommando "durch die Leitung" ist
CamServer.Active := false;
RVideo.Picture := BImage.Picture; //Das Bild einer WebCam aus einem "Backup"-Image in das VideoFenster laden
BtnStart.Enabled := true;
end;
procedure TfrmCam.BtnStartClick(Sender: TObject);
begin
frmCam.CamServer.Active := true;
frmMain.ClientSend(Syntax[cmdSTARTCAM].Text + #13);
BtnStart.Enabled := false;
BtnStop.Enabled := true;
end;
procedure TfrmCam.BtnStopClick(Sender: TObject);
begin
CamStop;
end;
procedure TfrmCam.CamServerExecute(AContext: TIdContext);
var
FStream: TMemoryStream;
begin
FStream := TMemoryStream.Create;
try
AContext.Connection.Socket.ReadStream(FStream);
finally
try
FStream.Position := 0;
RVideo.Picture.Bitmap.LoadFromStream(FStream);
finally
FStream.Free;
end;
end;
end;