Einzelnen Beitrag anzeigen

ByTheTime

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

AW: Error Event für TIdTCPClient

  Alt 25. Okt 2012, 17:16
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;
Lukas
  Mit Zitat antworten Zitat