unit_main.pas

dos example for create a profesional templeta

unit Unit_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Spin, StdCtrls, ExtCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, Menus,IdGlobal,
  XPMan ;

type
  TConInfo = record
    isMouse:boolean;
    CmD:byte;
    x,y:Integer;  //坐标
  end;

  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Edit2: TEdit;
    Button2: TButton;
    ComboBox1: TComboBox;
    Image1: TImage;
    XPManifest1: TXPManifest;
    ComboBox2: TComboBox;
    Image2: TImage;
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure LoadScreen;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox2Change(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TListenThread = class(TThread )
    TheClient : TIdTCPClient;
  protected
  private
    procedure Execute; override;
  public
    constructor Create (AClient :TIdTCPClient );
  end;

var
  Form1: TForm1;
  tmpstream,tmpstream1:TMemoryStream;
  TmpBmp:TBitMap;
  Num:Integer;
  ListenThread :TListenThread ;
  StopTs:boolean;

implementation

uses IdIOHandler,ZLIBEX;

{$R *.dfm}

procedure MyDeCompress(AStream: TStream);
var
  DeCompressionStream: TZDecompressionStream;
  TmpStream :TMemoryStream ;
Begin
try
  try
    TmpStream := TMemoryStream.Create ;
    AStream.Position := 0;
    TmpStream.LoadFromStream(AStream );
    AStream.Size := 0;
    DecompressionStream := TZDecompressionStream.Create(TmpStream);
    AStream.CopyFrom(DecompressionStream, 0);
    AStream.Position := 0;
  finally
    TmpStream.Free ;
    DeCompressionStream.Free ;
  end;
except on E: Exception do
  ShowMessage(e.Message )
end;
end;

procedure TForm1.LoadScreen;
var
  P:TPoint;
  ssize,i,ss:Integer;
  C:Char;
begin
  if not Assigned(tmpstream1) then  tmpstream1:=TMemoryStream.Create;
  MyDeCompress(tmpstream);
  ss:= tmpstream.Size;
  tmpstream.Seek(0,soFromBeginning );
  tmpstream.Read(c,1);
//  tmpstream.Read(p,SizeOf(p));
//  Image2.Top := p.Y;
//  Image2.Left := p.X;
  if C = 'F' then
  begin
    tmpstream.Read(p,SizeOf(p));
    Image1.Width := p.X;
    Image1.Height := p.Y;
    TmpBmp.LoadFromStream(tmpstream);
    Form1.Image1.Canvas.Draw(0,0,TmpBmp);
  end
  else
  begin
    i:=1;
    while i < ss do
      begin
        i:= i + tmpstream.Read(p,SizeOf(p));
        i:= i + tmpstream.Read(ssize,SizeOf(Integer ));
        i:= i + tmpstream1.CopyFrom(tmpstream,ssize) ;
        tmpstream1.Position := 0;
        TmpBmp.LoadFromStream(tmpstream1 );
        Image1.Canvas.Draw(p.X,p.Y,TmpBmp);
        tmpstream1.Clear;
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
  IdTCPClient1.Host := ComboBox1.Text;
  IdTCPClient1.Port := StrToInt(Edit2.Text );
  if not IdTCPClient1.Connected  then
    IdTCPClient1.Connect
  else
    IdTCPClient1.Disconnect ;
except  on E: Exception do
  begin
    ShowMessage(e.Message );
  end;
end
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if Button2.Caption = 'BeginTrans' then
  begin
    IdTCPClient1.WriteLn('BeginScreenTransfer');
    IdTCPClient1.WriteLn('GetFirstScreen');
    Button2.Caption := 'StopTrans';
    StopTs := false;

  end
else
  begin
    //IdTCPClient1.IOHandler.WriteLn('StopScreenTransfer');
    stopts := true;
    Button2.Caption := 'BeginTrans';
  end
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPClient1.Disconnect;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
IdTCPClient1.WriteLn('Src');
tmpstream := TMemoryStream.Create;
TmpBmp := TBitMap.Create;
Num := 0;
Button1.Caption := 'Disconnect';
//Image2.Visible := True;
ListenThread := TListenThread.Create(IdTCPClient1);
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
tmpstream.Free;
TmpBmp.Free;
ListenThread.Terminate ;
//Image2.Visible := False ;
Button1.Caption := 'Connect';
end;


/////////////////////////
//////接收命令线程///////
/////////////////////////
constructor TListenThread.Create(AClient :TIdTCPClient );
begin
TheClient := aclient;
FreeOnTerminate := True;
inherited Create(False );
end;


procedure TListenThread.Execute;
var
  i:Integer;
  s:string;
begin
while (not Terminated ) and (TheClient.Connected ) do
  begin
    try
      try
        s:=TheClient.ReadLn ;
      except
        Continue;
      end;
      if s = 'NextScreen' then
        begin
          i := TheClient.ReadInteger();
          Inc(Num );
          Form1.Caption := Format('Recvicing %d frame,Size%dByte',[Num,i]);
          tmpstream.Clear;
          TheClient.ReadStream(tmpstream,i);
          if stopts then
            TheClient.WriteLn('StopScreenTransfer')
          else
            TheClient.WriteLn('GetNextScreen');
          Synchronize(Form1.LoadScreen);
        end
      else if S = 'ScreenNotChange' then
        begin
          Inc(Num );
          Form1.Caption := Format('Recvicing %d frame,Screen ' +
            'did not change! --- Client Demo',[Num]);
          if stopts then
            TheClient.WriteLn('StopScreenTransfer')
          else
            TheClient.WriteLn('GetNextScreen');
        end;
    except
    end;
  end;
end;




procedure TForm1.ComboBox2Change(Sender: TObject);
var
  b:Byte ;
begin
  case ComboBox2.ItemIndex of
    0:b:=4;
    1:b:=8;
    2:b:=16;
    4:b:=24;
  end;
  IdTCPClient1.WriteLn('SetPixels');
  IdTCPClient1.WriteChar(Char(b));
end;

end.