Exame Informatica 142/Exame Informatica 142.iso/Programas/Cerberus/CerberusSetup.exe/CerberusNET_Source/ClientMain.pas

Pascal/Delphi Source File | 2006-01-29 | 9.1 KB | 392 lines

{
 (C) Paul Alan Freshney 2006
 (Based on an Indy Client Demo)

  Last Modified: January 29th 2006

  This code is free to use as you wish. Please do not distribute this code without
  authorisation from myself. We are free to distribute versions of CerberusNET as
  you wish as long as you link to "www.paulalanfreshney.com/cerberus" somewhere
  within the application!

  391
}

unit ClientMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, Grids, jpeg,
  ComCtrls, ToolWin, ImgList, XPMan;

type
  TfrmMain = class(TForm)
      TCPClient: TIdTCPClient;
    timerMain: TTimer;
    Cam1: TImage;
    ImageList1: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tbSingle: TToolButton;
    tbStream: TToolButton;
    statusMain: TStatusBar;
    CoolBar2: TCoolBar;
    XPManifest1: TXPManifest;
    ToolBar2: TToolBar;
    tbPreferences: TToolButton;
    tbAbout: TToolButton;
    ToolButton2: TToolButton;
    Cam2: TImage;
    Cam3: TImage;
    Cam4: TImage;
    Cam5: TImage;
    Cam6: TImage;
    Cam7: TImage;
    Cam8: TImage;
    Cam9: TImage;
    Cam10: TImage;
      procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure timerMainTimer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tbPreferencesClick(Sender: TObject);
    procedure LoadSettings;
    procedure SaveSettings;
    procedure tbAboutClick(Sender: TObject);
    procedure tbStreamClick(Sender: TObject);
    procedure RebuildDisplay;
    procedure TCPClientStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    private
    public
    end;

var
    frmMain: TfrmMain;

implementation

{$R *.DFM}

uses utility, inifiles, preferences, about;

var
 CamCount : integer;
 CamList : array[1..10] of TImage;

procedure TfrmMain.FormCreate(Sender: TObject);
 var
  t : integer;

 begin
  Caption:='CerberusNET '+CNET_Version+' / '+CNET_Date+' - (c) PAF 2005';

  Height:=210;
  Width:=286;

  LoadSettings;

  timerMain.Interval:=CNETPreferenes.CRefresh*1000;

  CamList[1]:=Cam1;
  CamList[2]:=Cam2;
  CamList[3]:=Cam3;
  CamList[4]:=Cam4;
  CamList[5]:=Cam5;
  CamList[6]:=Cam6;
  CamList[7]:=Cam7;
  CamList[8]:=Cam8;
  CamList[9]:=Cam9;
  CamList[10]:=Cam10;

  for t:=2 to 10 do
    CamList[t].Picture.Assign(CamList[1].Picture);

  CamCount:=1;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
  SaveSettings;
end;

procedure TfrmMain.LoadSettings;
 var
  config : TINIFile;

 begin
  config:=TIniFile.Create('CerberusNET.ini');
  try
    Top   :=config.ReadInteger('Main', 'Top', 50);
    Left  :=config.ReadInteger('Main', 'Left', 50);

    with CNETPreferenes do begin
      CHost    :=config.ReadString('Connection', 'Host', '127.0.0.1');
      CPort    :=config.ReadInteger('Connection', 'Port', 8090);
      CRefresh :=config.ReadInteger('Connection', 'Refresh', 3);
    end;
  except
    config.Free;
  end;
end;

procedure TfrmMain.SaveSettings;
 var
  config : TINIFile;

 begin
  config:=TIniFile.Create('CerberusNET.ini');
  try
    config.WriteInteger('Main', 'Top', Top);
    config.WriteInteger('Main', 'Left', Left);

    with CNETPreferenes do begin
      config.WriteString('Connection', 'Host', CHost);
      config.WriteInteger('Connection', 'Port', CPort);
      config.WriteInteger('Connection', 'Refresh', CRefresh);
    end;
  except
    config.Free;
  end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);

var
    SResponse: String;
  AvailableCams : string;
    AStream: TMemoryStream;
  OldCamCount,t,i : integer;
  brian : TJPEGIMage;

begin
  OldCamCount:=0;

    with TCPClient do    begin
    try
          Connect;
    except
      on E: Exception do begin
        statusMain.SimpleText:=E.Message;

        if timerMain.Enabled then tbStreamClick(Nil);
      end;
    end;

        while Connected do
        begin
            AStream := TMemoryStream.Create;

            try
                // banner means the server thread is running
                SResponse := UpperCase(ReadLn);
                if Pos('CX', SResponse) = 0 then Break;

        AvailableCams:=Copy(SResponse, 4, 10);

        OldCamCount:=0;
        for t:=1 to 10 do
          if AvailableCams[t]='A' then inc(OldCamCount);

        //Caption:=AvailableCams;

        if OldCamCount<>0 then begin
          i:=1;
          for t:=1 to 10 do begin
            if AvailableCams[t]='A' then begin
                       // request OUTLINE data
              AStream := TMemoryStream.Create;

                      WriteLn('CAM'+CHR(64+t));

                      ReadStream(AStream, -1, True);
                      AStream.Seek(0, soFromBeginning);

              brian:=TJPEGImage.Create;
              brian.LoadFromStream(AStream);
              CamList[i].Picture.Graphic.Assign(brian);

              inc(i);

              // bit of a hack :)
              Disconnect;
              Connect;
              SResponse := UpperCase(ReadLn);
            end;
          end;
        end
        else begin
          statusMain.SimpleText:='No Webcams active on CerberusServer '+CNETPreferenes.CHost;
        end;
            finally
                Disconnect;
                AStream.Free;
            end;
        end;
    end;

  if OldCamCount<>CamCount then begin
    CamCount:=OldCamCount;

    RebuildDisplay;
  end;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
 begin
    timerMain.Enabled := not timerMain.Enabled;
end;

procedure TfrmMain.timerMainTimer(Sender: TObject);
begin
    try
    Button1Click(Nil);
    except // reset the timer and raise the exception
        begin

            raise;
        end;
    end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
//    Button1.Width := (Width-26) div 2;
//    Button2.Width :=     Button1.Width;
//    Button2.Left  :=     Button1.Left + Button1.Width + 4;
end;

procedure TfrmMain.tbPreferencesClick(Sender: TObject);
 begin
  if DoPreferences=mrOK then begin
    TCPClient.Host:=CNETPreferenes.CHost;
    TCPClient.Port:=CNETPreferenes.CPort;

    timerMain.Interval:=CNETPreferenes.CRefresh*1000;
  end;
end;

procedure TfrmMain.tbAboutClick(Sender: TObject);
 begin
  frmAbout.ShowModal;
end;

procedure TfrmMain.tbStreamClick(Sender: TObject);
 begin
  timerMain.Enabled:=not(timerMain.Enabled);

  tbSingle.Enabled      :=not(timerMain.Enabled);
  tbPreferences.Enabled :=not(timerMain.Enabled);
  tbAbout.Enabled       :=not(timerMain.Enabled);
end;

procedure TfrmMain.RebuildDisplay;
 var
  x : integer;

 begin
  case CamCount of
    0,1 : begin
            Height:=210;
            Width:=286;
          end;
    2   : begin
            Height:=210;
            Width:=469;
          end;
    3   : begin
            Height:=210;
            Width:=653;
          end;
    4   : begin
            Height:=210;
            Width:=837;

            for x:=0 to 3 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;
            end;
          end;
    5   : begin
            Height:=210;
            Width:=1019;

            for x:=0 to 4 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;
            end;
          end;
    6   : begin
            Height:=361;
            Width:=653;

            for x:=0 to 2 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;

              CamList[x+4].Left:=96+(x*184);
              CamList[x+4].Top:=160;
            end;
          end;
    7   : begin
            Height:=361;
            Width:=835;

            for x:=0 to 3 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;

              CamList[x+4].Left:=96+(x*184);
              CamList[x+4].Top:=160;
            end;
          end;
    8   : begin
            Height:=361;
            Width:=835;

            for x:=0 to 3 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;

              CamList[x+5].Left:=96+(x*184);
              CamList[x+5].Top:=160;
            end;
          end;
    9   : begin
            Height:=361;
            Width:=1019;

            for x:=0 to 4 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;

              CamList[x+6].Left:=96+(x*184);
              CamList[x+6].Top:=160;
            end;
          end;
    10  : begin
            Height:=361;
            Width:=1019;

            for x:=0 to 4 do begin
              CamList[x+1].Left:=96+(x*184);
              CamList[x+1].Top:=8;

              CamList[x+6].Left:=96+(x*184);
              CamList[x+6].Top:=160;
            end;
          end;
  end;
end;

procedure TfrmMain.TCPClientStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
 begin
  statusMain.SimpleText:=AStatusText;
end;

end.