www.pudn.com > ServerClient-tcp.rar > ClientFrm.pas
unit ClientFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, ComCtrls, FormSettings, Menus, StdCtrls, Buttons,
RemConMessages, ZLib;
const
DEFAULT_SERVER_DELAY = 500;
DEFAULT_VIEW_MODE = vmColor4;
DEFAULT_COMP_MODE = clDefault;
DEFAULT_SVR_PRIORITY = THREAD_PRIORITY_HIGHEST;
type
TMoveObj = class
X, Y : integer;
Time : integer;
end;
TClientForm = class(TForm)
StatPanel: TPanel;
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
Image1: TImage;
ClientSocket1: TClientSocket;
Timer1: TTimer;
FormSettings1: TFormSettings;
MainMenu1: TMainMenu;
File1: TMenuItem;
Connect1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Disconnect1: TMenuItem;
View1: TMenuItem;
RefreshComplete1: TMenuItem;
UpdateChanges1: TMenuItem;
ResponseTimer: TTimer;
ClickTimer: TTimer;
Options1: TMenuItem;
ServerPause1: TMenuItem;
N005sec1: TMenuItem;
N010sec1: TMenuItem;
N050sec1: TMenuItem;
N100sec1: TMenuItem;
N200sec1: TMenuItem;
N500sec1: TMenuItem;
LogList: TListBox;
Splitter1: TSplitter;
N2: TMenuItem;
Log1: TMenuItem;
CommStat1: TMenuItem;
N3: TMenuItem;
Shutdown1: TMenuItem;
Special1: TMenuItem;
FocusServerWindow1: TMenuItem;
BitmapFormat1: TMenuItem;
Color4: TMenuItem;
Gray4: TMenuItem;
Gray8: TMenuItem;
Color24: TMenuItem;
Default1: TMenuItem;
WaitImage: TImage;
CompressionLevel1: TMenuItem;
HighSlow1: TMenuItem;
Medium1: TMenuItem;
LowFast1: TMenuItem;
ServerPriority1: TMenuItem;
Critical1: TMenuItem;
Highest1: TMenuItem;
AboveNormal1: TMenuItem;
Normal1: TMenuItem;
BelowNormal1: TMenuItem;
Lowest1: TMenuItem;
Idle1: TMenuItem;
N4: TMenuItem;
ScaleImage1: TMenuItem;
ProcessList1: TMenuItem;
N5: TMenuItem;
FileList1: TMenuItem;
Panel1: TPanel;
SendCRBut: TSpeedButton;
SendBut: TSpeedButton;
SendPanel: TPanel;
SendEdit: TEdit;
Help1: TMenuItem;
About1: TMenuItem;
StatBarMenu: TMenuItem;
FullScreen1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Exit1Click(Sender: TObject);
procedure Connect1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Disconnect1Click(Sender: TObject);
procedure RefreshComplete1Click(Sender: TObject);
procedure UpdateChanges1Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ResponseTimerTimer(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1Click(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
procedure ClickTimerTimer(Sender: TObject);
procedure PauseChange(Sender: TObject);
procedure SendButClick(Sender: TObject);
procedure SendCRButClick(Sender: TObject);
procedure Log1Click(Sender: TObject);
procedure CommStat1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Shutdown1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FocusServerWindow1Click(Sender: TObject);
procedure ColorClick(Sender: TObject);
procedure CompClick(Sender: TObject);
procedure PriorityClick(Sender: TObject);
procedure ScaleImage1Click(Sender: TObject);
procedure ProcessList1Click(Sender: TObject);
procedure FileList1Click(Sender: TObject);
procedure SendPanelResize(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure StatBarMenuClick(Sender: TObject);
procedure FullScreen1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
protected
NumRec : double;
NumSend : double;
CurMsg : string;
NeedReply : integer;
LastX : integer;
LastY : integer;
t1 : DWORD;
but : integer;
NumClick : integer;
MoveList : TList;
Anim : integer;
LastRec : DWORD;
ServerDelay: integer;
ViewMode : TViewMode;
CompMode : TCompressionLevel;
SvrPriority: integer;
ProcForm : TForm;
FileForm : TForm;
LastCPS : string;
BeforeFull : TRect;
procedure SetStat(i: integer; s: string);
procedure UpdateStats;
procedure SendText(const Text: string);
procedure Log(const s: string);
procedure EnableButs;
procedure ClearMoveList;
procedure AddMove(x, y: integer);
procedure ParseComLine;
procedure StopAnim;
procedure StartAnim;
procedure EnableInput;
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
function CanSendMenuMsg: boolean;
procedure Send_Current_Settings;
procedure ScaleXY(var X, Y: integer);
procedure UpdateLogVis;
public
procedure SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
procedure ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
property Stat[i: integer]: string write SetStat;
end;
var
ClientForm: TClientForm;
implementation
uses ConnectDlg, ProcListDlg, FilesDlg, About, FsTopDlg;
{$R *.DFM}
procedure TClientForm.FormShow(Sender: TObject);
begin
UpdateLogVis;
if not ClientSocket1.Active then
Timer1.Enabled := True;
end;
function IsDotAddress(const s: string): boolean;
var
i : integer;
begin
Result := True;
for i := 1 to Length(s) do
if not (s[i] in ['0'..'9', '.']) then Result := False;
end;
procedure TClientForm.Timer1Timer(Sender: TObject);
var
f : TForm;
begin
Timer1.Enabled := False;
f := Self;
with ClientConnectForm do begin
Left := (f.Left + f.Width div 2) - Width div 2;
Top := (f.Top + f.Height div 2) - Height div 2;
if ShowModal = mrOK then with ClientSocket1 do begin
if IsDotAddress(ServerCombo.Text) then begin
Host := '';
Address := ServerCombo.Text;
end else begin
Address := '';
Host := ServerCombo.Text;
end;
Port := StrToInt(PortEdit.Text);
StartAnim;
Active := True;
end;
end;
end;
procedure TClientForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if BorderStyle<>bsNone then FormSettings1.SaveSettings;
Disconnect1Click(nil);
end;
procedure TClientForm.ClientSocket1Lookup(Sender: TObject;
Socket: TCustomWinSocket);
begin
Stat[0] := ('Looking up: ' + ClientSocket1.Host);
end;
procedure TClientForm.SetStat(i: integer; s: string);
begin
FSTopForm.StatLabel.Caption := s;
StatusBar1.Panels[i].Text := s;
Update;
end;
procedure TClientForm.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Stat[0] := ('Connecting: ' + ClientSocket1.Host);
end;
procedure TClientForm.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-7s %s', ['LogOn', DateTimeToStr(Now)]));
EnableButs;
Stat[0] := ('Connected: ' + Socket.RemoteHost);
Caption := 'Remote Control Client - ' + Socket.RemoteHost;
NumSend := 0;
NumRec := 0;
NeedReply := 0;
StopAnim;
EnableInput;
SendMsg(MSG_LOGON, ClientConnectForm.PassEdit.Text, ClientSocket1.Socket);
Send_Current_Settings;
end;
procedure TClientForm.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Stat[0] := ('Error: ' + IntToStr(ErrorCode));
ErrorCode := 0;
if not Socket.Connected then StopAnim;
end;
procedure TClientForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TClientForm.Connect1Click(Sender: TObject);
begin
Image1.Picture.Bitmap := nil;
Timer1Timer(nil);
end;
procedure TClientForm.SendMsg(MsgNum: integer; const MsgData: string; Socket: TCustomWinSocket);
var
s : string;
begin
Log(Format('%-7s #%2.2d', ['Send', MsgNum]));
Stat[0] := Format('Sending Message (Len = %1.0n)', [Length(MsgData)+0.0]);
s := IntToByteStr(MsgNum) + IntToByteStr(Length(MsgData)) + MsgData;
Socket.SendText(s);
NumSend := NumSend + Length(s);
UpdateStats;
Inc(NeedReply);
StartAnim;
end;
procedure TClientForm.UpdateStats;
begin
// Stat[0] := Format('Sent: %1.0n', [NumSend]);
// Stat[1] := Format('Recv: %1.0n', [NumRec]);
end;
procedure TClientForm.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s : string;
msg : integer;
len : integer;
PerStr : string;
tdif : double;
cps : string;
begin
// WaitImage.Hint := 'Data Last Received:' + #13#10 + CurTime;
s := Socket.ReceiveText;
NumRec := NumRec + Length(s);
UpdateStats;
if CurMsg = '' then LastRec := GetTickCount;
CurMsg := CurMsg + s;
if Length(CurMsg) >= 8 then begin
Move(CurMsg[1], msg, sizeof(integer));
Move(CurMsg[5], len, sizeof(integer));
PerStr := Format('(%1.0n%%)', [Length(CurMsg) / (len + 8.0) * 100.0]);
tdif := (GetTickCount - LastRec) / 1000.0;
if tdif > 0.5 then cps := Format('%1.0n cps', [Length(CurMsg) / tdif])
else cps := '';
Stat[0] := Format('Received: %1.0n of %1.0n %s %s',
[Length(CurMsg) + 0.0, len + 8.0, PerStr, cps]);
LastCPS := cps;
end else begin
if Length(s) > 0 then
Stat[0] := 'Received: ' + IntToStr(Length(CurMsg));
end;
while IsValidMessage(CurMsg) do begin
s := TrimFirstMsg(CurMsg);
ProcessMessage(s, Socket);
end;
end;
procedure TClientForm.ProcessMessage(const Msg: string; Socket: TCustomWinSocket);
var
MsgNum : integer;
Data : string;
bmp : TBitmap;
R : TRect;
begin
Move(Msg[1], MsgNum, sizeof(integer));
if MsgNum <> MSG_STAT_MSG then
Log(Format('%-7s #%0.2d %6.0n bytes %s', ['Recv', MsgNum, Length(Msg)+0.0, LastCPS]));
Data := Copy(Msg, 9, Length(Msg));
if MsgNum = MSG_STAT_MSG then begin
Stat[0] := Data;
exit;
end;
Dec(NeedReply);
if NeedReply = 0 then begin
StopAnim;
end;
if MsgNum = MSG_LOGON then begin
if Data <> '0' then begin
Stat[0] := 'Log on Successful';
if ClientConnectForm.StartScreenBox.Checked then
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end else begin
Stat[0] := 'Invalid Password!';
MessageDlg('Invalid Password!', mtWarning, [mbOK], 0);
end;
end;
if MsgNum = MSG_REFRESH then begin
Stat[0] := 'Decompressing';
SaveString(Data, 'Temp2.txt');
UnCompressBitmap(Data, Image1.Picture.Bitmap);
Stat[0] := 'Ready';
end;
if MsgNum = MSG_SCREEN_UPDATE then begin
bmp := TBitmap.Create;
Stat[0] := 'Decompressing';
UnCompressBitmap(Data, bmp);
R := Rect(0, 0, bmp.Width, bmp.Height);
with Image1.Picture.Bitmap.Canvas do begin
CopyMode := cmSrcInvert;
CopyRect(R, bmp.Canvas, R);
end;
Stat[0] := 'Ready';
bmp.Free;
end;
if MsgNum = MSG_SEVER_DELAY then begin
Stat[0] := 'Server Delay Set';
end;
if MsgNum = MSG_VIEW_MODE then begin
Stat[0] := 'View Mode Set';
end;
if MsgNum = MSG_COMP_MODE then begin
Stat[0] := 'Compression Mode Set';
end;
if MsgNum = MSG_PRIORITY_MODE then begin
Stat[0] := 'Priority Mode Set';
end;
if MsgNum = MSG_PROCESS_LIST then begin
if ProcForm = nil then
ProcForm := TProcListForm.Create(Self);
(ProcForm as TProcListForm).SetList(Data);
ProcForm.Show;
Stat[0] := 'Received Process List';
end;
if MsgNum = MSG_DRIVE_LIST then begin
if FileForm = nil then
FileForm := TFilesForm.Create(Self);
(FileForm as TFilesForm).SetDriveList(Data);
FileForm.Show;
Stat[0] := 'Received Drive List';
end;
if MsgNum = MSG_DIRECTORY then begin
Assert(FileForm <> nil);
(FileForm as TFilesForm).SetDirData(Data);
FileForm.Show;
Stat[0] := 'Received Directory';
end;
if MsgNum = MSG_FILE then begin
Assert(FileForm <> nil);
Stat[0] := 'Received File';
(FileForm as TFilesForm).SetFileData(Data);
end;
if MsgNum = MSG_REMOTE_LAUNCH then begin
Stat[0] := 'Launched File: ' + Data;
end;
end;
procedure TClientForm.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Log(Format('%-7s %s', ['LogOff', DateTimeToStr(Now)]));
ClientSocket1.Active := False;
EnableButs;
Stat[0] := ('Disconnected: ' + Socket.RemoteHost);
Caption := 'Remote Control Client';
StopAnim;
end;
procedure TClientForm.Disconnect1Click(Sender: TObject);
begin
Stat[0] := 'Disconnecting...';
ClientSocket1.Active := False;
EnableButs;
StopAnim;
end;
procedure TClientForm.RefreshComplete1Click(Sender: TObject);
begin
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end;
procedure TClientForm.UpdateChanges1Click(Sender: TObject);
begin
SendMsg(MSG_SCREEN_UPDATE, '', ClientSocket1.Socket);
end;
procedure TClientForm.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
ScaleXY(X, Y);
LastX := X;
LastY := Y;
AddMove(X, Y);
end;
procedure TClientForm.AddMove(x, y: integer);
var
MoveObj : TMoveObj;
begin
MoveObj := TMoveObj.Create;
MoveObj.X := X;
MoveObj.Y := Y;
MoveObj.Time := GetTickCount;
MoveList.Add(MoveObj);
end;
procedure TClientForm.ResponseTimerTimer(Sender: TObject);
var
bm : TBitmap;
x, y : integer;
begin
WaitImage.Hint := Format('Wait: %3.1n seconds', [(GetTickCount-t1)/1000.0]);
bm := TBitmap.Create;
bm.Width := WaitImage.Width;
bm.Height := WaitImage.Height;
Anim := Anim + 1;
Anim := Anim and 31;
for x := -1 to 1 do
for y := -1 to 1 do
bm.Canvas.Draw(Anim + x*32, Anim + y*32, Application.Icon);
WaitImage.Picture.Assign(bm);
bm.Free;
end;
procedure TClientForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ScaleXY(X, Y);
but := 1;
if Button = mbRight then but := 2;
ClearMoveList;
AddMove(x, y);
end;
procedure TClientForm.Image1Click(Sender: TObject);
begin
NumClick := 1;
ClickTimer.Enabled := True;
end;
procedure TClientForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ScaleXY(X, Y);
if but = 2 then begin
// Only do this for Right Clicks
SendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +
IntToByteStr(1 {Single}) + IntToByteStr(but), ClientSocket1.Socket);
end;
AddMove(x, y);
end;
procedure TClientForm.Image1DblClick(Sender: TObject);
begin
NumClick := 2;
ClickTimer.Enabled := True;
end;
procedure TClientForm.ClickTimerTimer(Sender: TObject);
var
s : string;
MoveObj : TMoveObj;
i : integer;
begin
ClickTimer.Enabled := False;
if (MoveList.Count < 5) or (NumClick = 2) then begin
// This is a Click or Double-click
SendMsg(MSG_CLICK, IntToByteStr(LastX) + IntToByteStr(LastY) +
IntToByteStr(NumClick) + IntToByteStr(but), ClientSocket1.Socket);
end else begin
// This is a "drag" operation
s := IntToByteStr(but) + IntToByteStr(MoveList.Count);
for i := 0 to MoveList.Count-1 do begin
MoveObj := MoveList[i];
s := s + IntToByteStr(MoveObj.X) + IntToByteStr(MoveObj.Y)
+ IntToByteStr(MoveObj.time);
end;
SendMsg(MSG_DRAG, s, ClientSocket1.Socket);
end;
end;
procedure TClientForm.SendButClick(Sender: TObject);
begin
SendText(SendEdit.Text);
end;
procedure TClientForm.SendCRButClick(Sender: TObject);
begin
SendText(SendEdit.Text + #13);
end;
procedure TClientForm.SendText(const Text: string);
begin
SendMsg(MSG_KEYS, Text, ClientSocket1.Socket);
end;
procedure TClientForm.Log1Click(Sender: TObject);
begin
Log1.Checked := not Log1.Checked;
UpdateLogVis;
end;
procedure TClientForm.UpdateLogVis;
begin
LogList.Visible := Log1.Checked;
Splitter1.Visible := Log1.Checked;
if Log1.Checked then
LogList.Left := Splitter1.Left - 1;
end;
procedure TClientForm.Log(const s: string);
begin
LogList.ItemIndex := LogList.Items.Add(s);
end;
procedure TClientForm.CommStat1Click(Sender: TObject);
begin
CommStat1.Checked := not CommStat1.Checked;
StatPanel.Visible := CommStat1.Checked;
end;
procedure TClientForm.EnableButs;
var
b : boolean;
begin
b := ClientSocket1.Active;
Connect1.Enabled := not b;
Disconnect1.Enabled := b;
end;
procedure TClientForm.FormCreate(Sender: TObject);
begin
EnableButs;
MoveList := TList.Create;
ParseComLine;
StopAnim;
EnableInput;
ServerDelay := DEFAULT_SERVER_DELAY;
ViewMode := DEFAULT_VIEW_MODE;
CompMode := DEFAULT_COMP_MODE;
SvrPriority := DEFAULT_SVR_PRIORITY;
end;
procedure TClientForm.Shutdown1Click(Sender: TObject);
begin
Close;
Application.MainForm.Close;
end;
procedure TClientForm.FormDestroy(Sender: TObject);
begin
ClearMoveList;
MoveList.Free;
end;
procedure TClientForm.ClearMoveList;
var
i : integer;
begin
for i := 0 to MoveList.Count-1 do
TObject(MoveList[i]).Free;
MoveList.Clear;
end;
procedure TClientForm.FocusServerWindow1Click(Sender: TObject);
begin
SendMsg(MSG_FOCUS_SERVER, '', ClientSocket1.Socket);
end;
procedure TClientForm.ParseComLine;
var
i : integer;
s : string;
begin
for i := 1 to ParamCount do begin
s := UpperCase(ParamStr(i));
if s = '/CLIENT' then begin
Visible := True;
end;
end;
end;
procedure TClientForm.EnableInput;
var
b : boolean;
begin
b := (NeedReply = 0) and ClientSocket1.Active;
SendBut.Enabled := b;
SendCRBut.Enabled := b;
Image1.Enabled := b;
Special1.Enabled := b;
// Options1.Enabled := b;
end;
procedure TClientForm.StopAnim;
var
bmp : TBitmap;
begin
Screen.Cursor := crDefault;
ResponseTimer.Enabled := False;
// Stat[2] := 'Not Waiting';
bmp := TBitmap.Create;
bmp.Width := WaitImage.Width;
bmp.Height := WaitImage.Height;
bmp.Canvas.Draw(2, 2, Application.Icon);
WaitImage.Picture.Assign(bmp);
bmp.Free;
EnableInput;
end;
procedure TClientForm.StartAnim;
begin
Anim := 2;
ResponseTimer.Enabled := True;
// Stat[2] := 'Waiting';
t1 := GetTickCount;
Screen.Cursor := crAppStart;
EnableInput;
end;
procedure TClientForm.WMSysCommand(var Message: TWMSysCommand);
begin
if (Message.CmdType and $FFF0 = SC_MINIMIZE) then
Application.Minimize
else
inherited;
end;
function TClientForm.CanSendMenuMsg: boolean;
begin
Result := ClientSocket1.Active;
end;
procedure TClientForm.PauseChange(Sender: TObject);
var
d : integer;
begin
d := 0;
(Sender as TMenuItem).Checked := True;
if Sender = N005sec1 then d := 50;
if Sender = N010sec1 then d := 100;
if Sender = N050sec1 then d := 500;
if Sender = N100sec1 then d := 1000;
if Sender = N200sec1 then d := 2000;
if Sender = N500sec1 then d := 5000;
ServerDelay := d;
if CanSendMenuMsg then
SendMsg(MSG_SEVER_DELAY, IntToByteStr(d), ClientSocket1.Socket);
end;
procedure TClientForm.ColorClick(Sender: TObject);
var
vm : TViewMode;
x : integer;
begin
(Sender as TMenuItem).Checked := True;
vm := vmDefault;
if Sender = Color4 then vm := vmColor4;
if Sender = Gray4 then vm := vmGray4;
if Sender = Gray8 then vm := vmGray8;
if Sender = Color24 then vm := vmColor24;
if Sender = Default1 then vm := vmDefault;
ViewMode := vm;
if CanSendMenuMsg then begin
x := integer(vm);
SendMsg(MSG_VIEW_MODE, IntToByteStr(x), ClientSocket1.Socket);
SendMsg(MSG_REFRESH, '', ClientSocket1.Socket);
end;
end;
procedure TClientForm.CompClick(Sender: TObject);
var
cm : TCompressionLevel;
begin
(Sender as TMenuItem).Checked := True;
cm := clDefault;
if Sender = HighSlow1 then cm := clMax;
if Sender = Medium1 then cm := clDefault;
if Sender = LowFast1 then cm := clFastest;
CompMode := cm;
if CanSendMenuMsg then
SendMsg(MSG_COMP_MODE, IntToByteStr(integer(cm)), ClientSocket1.Socket);
end;
procedure TClientForm.PriorityClick(Sender: TObject);
var
x : integer;
begin
(Sender as TMenuItem).Checked := True;
x := THREAD_PRIORITY_NORMAL;
if Sender = Critical1 then x := THREAD_PRIORITY_TIME_CRITICAL;
if Sender = Highest1 then x := THREAD_PRIORITY_HIGHEST;
if Sender = AboveNormal1 then x := THREAD_PRIORITY_ABOVE_NORMAL;
if Sender = Normal1 then x := THREAD_PRIORITY_NORMAL;
if Sender = BelowNormal1 then x := THREAD_PRIORITY_BELOW_NORMAL;
if Sender = Lowest1 then x := THREAD_PRIORITY_LOWEST;
if Sender = Idle1 then x := THREAD_PRIORITY_IDLE;
SvrPriority := x;
if CanSendMenuMsg then
SendMsg(MSG_PRIORITY_MODE, IntToByteStr(x), ClientSocket1.Socket);
end;
procedure TClientForm.Send_Current_Settings;
begin
SendMsg(MSG_SEVER_DELAY, IntToByteStr(ServerDelay), ClientSocket1.Socket);
SendMsg(MSG_VIEW_MODE, IntToByteStr(integer(ViewMode)), ClientSocket1.Socket);
SendMsg(MSG_COMP_MODE, IntToByteStr(integer(CompMode)), ClientSocket1.Socket);
SendMsg(MSG_PRIORITY_MODE, IntToByteStr(SvrPriority), ClientSocket1.Socket);
end;
procedure TClientForm.ScaleImage1Click(Sender: TObject);
begin
ScaleImage1.Checked := not ScaleImage1.Checked;
if ScaleImage1.Checked then begin
Image1.AutoSize := False;
Image1.Stretch := True;
Image1.Align := alClient;
end else begin
Image1.AutoSize := True;
Image1.Stretch := False;
Image1.Align := alNone;
Image1.Picture.Assign(Image1.Picture.Graphic); // To trigger the Autosize property
end;
end;
procedure TClientForm.ScaleXY(var X, Y: integer);
begin
if not ScaleImage1.Checked then exit;
with Image1 do begin
X := X * Picture.Width div Width;
Y := Y * Picture.Height div Height;
end;
end;
procedure TClientForm.ProcessList1Click(Sender: TObject);
begin
SendMsg(MSG_PROCESS_LIST, '', ClientSocket1.Socket);
end;
procedure TClientForm.FileList1Click(Sender: TObject);
begin
SendMsg(MSG_DRIVE_LIST, '', ClientSocket1.Socket);
end;
procedure TClientForm.SendPanelResize(Sender: TObject);
begin
SendEdit.Width := SendPanel.ClientWidth - 8;
end;
procedure TClientForm.About1Click(Sender: TObject);
begin
AboutBox.ShowModal;
end;
procedure TClientForm.StatBarMenuClick(Sender: TObject);
begin
StatBarMenu.Checked := not StatBarMenu.Checked;
StatusBar1.Visible := StatBarMenu.Checked;
end;
procedure TClientForm.FullScreen1Click(Sender: TObject);
begin
if BorderStyle = bsSizeable then begin
BeforeFull := BoundsRect;
Menu := nil;
Left := 0;
Top := 0;
Width := Screen.Width;
Height := Screen.Height;
BorderStyle := bsNone;
StatPanel.Visible := False;
StatusBar1.Visible := False;
ScrollBox1.BorderStyle := bsNone;
FSTopForm.Show;
end else begin
BoundsRect := BeforeFull;
Menu := MainMenu1;
BorderStyle := bsSizeable;
StatPanel.Visible := True;
StatusBar1.Visible := True;
ScrollBox1.BorderStyle := bsSingle;
FSTopForm.Hide;
end;
end;
procedure TClientForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// If in Full-Screen mode, do an extra check for Hot-Keys on the popup menu
if BorderStyle = bsNone then begin
FSTopForm.CheckShortCut(Key, Shift);
end;
end;
end.