432 lines
10 KiB
ObjectPascal
432 lines
10 KiB
ObjectPascal
unit Main;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, Sockets, ScktComp, StdCtrls, ComCtrls, ExtCtrls, Clipbrd, HTTPApp;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
SetBuilding: TButton;
|
|
ExitButton: TButton;
|
|
State: TUpDown;
|
|
Edit1: TEdit;
|
|
Building: TUpDown;
|
|
Edit2: TEdit;
|
|
lbl: TLabel;
|
|
SetFloor: TButton;
|
|
Floor: TUpDown;
|
|
Edit3: TEdit;
|
|
SetRoom: TButton;
|
|
Strip: TUpDown;
|
|
Edit4: TEdit;
|
|
DomeOn: TButton;
|
|
DomeOff: TButton;
|
|
BuildingsOn: TButton;
|
|
BuildingsOff: TButton;
|
|
StreetOn: TButton;
|
|
StreetOff: TButton;
|
|
OfficeOn: TButton;
|
|
OfficeOff: TButton;
|
|
AutoMode: TButton;
|
|
SetAll: TButton;
|
|
StaticMode: TButton;
|
|
Dome: TCheckBox;
|
|
Buildings: TCheckBox;
|
|
Street: TCheckBox;
|
|
Office: TCheckBox;
|
|
Auto: TButton;
|
|
DomeAuto: TButton;
|
|
BuildingsAuto: TButton;
|
|
StreetAuto: TButton;
|
|
OfficeAuto: TButton;
|
|
DomeColor: TShape;
|
|
RoomColor2: TShape;
|
|
RoomColor1: TShape;
|
|
RoomLabel1: TLabel;
|
|
RoomLabel2: TLabel;
|
|
DomeLabel: TLabel;
|
|
RoomEdit1: TEdit;
|
|
RoomEdit2: TEdit;
|
|
DomeEdit: TEdit;
|
|
Timer: TTimer;
|
|
IP: TEdit;
|
|
Label1: TLabel;
|
|
MyPort: TEdit;
|
|
Port: TLabel;
|
|
Clear: TButton;
|
|
Reconnect: TButton;
|
|
Socket: TTcpClient;
|
|
procedure ExitButtonClick(Sender: TObject);
|
|
procedure SetBuildingClick(Sender: TObject);
|
|
procedure SetFloorClick(Sender: TObject);
|
|
procedure SetRoomClick(Sender: TObject);
|
|
procedure DomeOnClick(Sender: TObject);
|
|
procedure DomeOffClick(Sender: TObject);
|
|
procedure AutoModeClick(Sender: TObject);
|
|
procedure BuildingsOnClick(Sender: TObject);
|
|
procedure BuildingsOffClick(Sender: TObject);
|
|
procedure StreetOnClick(Sender: TObject);
|
|
procedure StreetOffClick(Sender: TObject);
|
|
procedure OfficeOnClick(Sender: TObject);
|
|
procedure OfficeOffClick(Sender: TObject);
|
|
procedure SetAllClick(Sender: TObject);
|
|
procedure StaticModeClick(Sender: TObject);
|
|
procedure AutoClick(Sender: TObject);
|
|
procedure DomeAutoClick(Sender: TObject);
|
|
procedure BuildingsAutoClick(Sender: TObject);
|
|
procedure StreetAutoClick(Sender: TObject);
|
|
procedure OfficeAutoClick(Sender: TObject);
|
|
procedure DomeColorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure RoomColor1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure RoomColor2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure EditCopy(Sender: TObject; MousePos: TPoint;
|
|
var Handled: Boolean);
|
|
procedure TimerTimer(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure ClearClick(Sender: TObject);
|
|
procedure ReconnectClick(Sender: TObject);
|
|
private
|
|
function Connect: Boolean;
|
|
function Parts: Byte;
|
|
procedure SetPartMode(Mode, Part: Byte);
|
|
procedure SetAllPartMode(Mode, Part: Byte);
|
|
function SelectColor(Brush: TBrush; Edit: TEdit): Boolean;
|
|
procedure GetColor(Code: Byte; Brush: TBrush);
|
|
procedure SetColor(Code: Byte; Brush: TBrush);
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
implementation
|
|
|
|
uses commands_model;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
//IP.Text := '192.168.30.105';
|
|
// Íàôèã íå íàäî òåïåðü
|
|
//Socket.RemoteHost := IP.Text;
|
|
//Socket.RemotePort := MyPort.Text;
|
|
end;
|
|
|
|
function TMainForm.Connect: Boolean;
|
|
begin
|
|
if not Socket.Connected then
|
|
begin
|
|
Caption := 'Connection to ' + IP.Text;
|
|
Socket.RemoteHost := IP.Text;
|
|
Socket.RemotePort := MyPort.Text;
|
|
Socket.Active := True;
|
|
if Socket.Connected then
|
|
begin
|
|
Caption := 'Connected';
|
|
GetColor(colorDome, DomeColor.Brush);
|
|
GetColor(colorRoom1, RoomColor1.Brush);
|
|
GetColor(colorRoom2, RoomColor2.Brush);
|
|
end
|
|
else
|
|
Caption := 'Connection error';
|
|
end;
|
|
|
|
Result := Socket.Connected;
|
|
end;
|
|
|
|
procedure TMainForm.ExitButtonClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TMainForm.TimerTimer(Sender: TObject);
|
|
var
|
|
Cmd: TCommandNOP;
|
|
begin
|
|
if not Socket.Connected then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdNOP;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
function read(Socket: TBaseSocket; var Buffer; Size: Integer):Boolean;
|
|
var
|
|
Pos:PByte;
|
|
n:Integer;
|
|
begin
|
|
Pos:=@Buffer;
|
|
while Size>0 do
|
|
begin
|
|
if not Socket.WaitForData(100) then
|
|
begin
|
|
Result:=False;
|
|
Exit;
|
|
end;
|
|
n:=Socket.ReceiveBuf(Pos^,Size);
|
|
Inc(Pos,n);
|
|
Dec(Size,n);
|
|
end;
|
|
Result:=True;
|
|
end;
|
|
|
|
procedure TMainForm.GetColor(Code: Byte; Brush: TBrush);
|
|
var
|
|
Cmd: TCommandGetColor;
|
|
Color: TColor;
|
|
RGB: TRGB absolute Color;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdGetColor;
|
|
Cmd.Code := Code;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
|
|
Color := clBlack;
|
|
read(Socket,RGB,sizeof(RGB));
|
|
Brush.Color := Color;
|
|
end;
|
|
|
|
procedure TMainForm.SetColor(Code: Byte; Brush: TBrush);
|
|
var
|
|
Cmd: TCommandSetColor;
|
|
Color: TColor;
|
|
RGB: TRGB absolute Color;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetColor;
|
|
Cmd.Code := Code;
|
|
Color := Brush.Color;
|
|
Cmd.RGB := RGB;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
function TMainForm.SelectColor(Brush: TBrush; Edit: TEdit): Boolean;
|
|
var
|
|
Dialog: TColorDialog;
|
|
Color: TColor;
|
|
RGB: TRGB absolute Color;
|
|
|
|
function frm(n: Integer): string;
|
|
begin
|
|
Result:=
|
|
StringReplace(
|
|
StringReplace(
|
|
FloatToStrF(n/255.0,ffGeneral,3,15)
|
|
,',','.',[])
|
|
,'0.','.',[]);
|
|
end;
|
|
|
|
begin
|
|
Dialog := TColorDialog.Create(Self);
|
|
Dialog.Color := Brush.Color;
|
|
Result := Dialog.Execute;
|
|
if Result then
|
|
Brush.Color := Dialog.Color;
|
|
Color := Brush.Color;
|
|
Edit.Text := frm(RGB.R) + ', ' + frm(RGB.G) + ', ' + frm(RGB.B);
|
|
Dialog.Free;
|
|
end;
|
|
|
|
procedure TMainForm.SetAllClick(Sender: TObject);
|
|
var
|
|
Cmd: TCommandSetAllState;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetAllState;
|
|
Cmd.State := State.Position;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
procedure TMainForm.SetBuildingClick(Sender: TObject);
|
|
var
|
|
Cmd: TCommandSetBuildingState;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetBuildingState;
|
|
Cmd.Building := Building.Position;
|
|
Cmd.State := State.Position;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
procedure TMainForm.SetFloorClick(Sender: TObject);
|
|
var
|
|
Cmd: TCommandSetFloorState;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetFloorState;
|
|
Cmd.Building := Building.Position;
|
|
Cmd.Floor := Floor.Position;
|
|
Cmd.State := State.Position;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
procedure TMainForm.SetRoomClick(Sender: TObject);
|
|
var
|
|
Cmd: TCommandSetRoomState;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetRoomState;
|
|
Cmd.Building := Building.Position;
|
|
Cmd.Strip := Strip.Position;
|
|
Cmd.Floor := Floor.Position;
|
|
Cmd.State := State.Position;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
Floor.Position := Floor.Position+1;
|
|
end;
|
|
|
|
procedure TMainForm.SetPartMode(Mode, Part: Byte);
|
|
var
|
|
Cmd: TCommandSetPartMode;
|
|
begin
|
|
if not Connect then Exit;
|
|
Cmd.Size := SizeOf(Cmd);
|
|
Cmd.Command := cmdSetPartMode;
|
|
Cmd.Mode := Mode;
|
|
Cmd.Part := Part;
|
|
Socket.SendBuf(Cmd, Cmd.Size);
|
|
end;
|
|
|
|
procedure TMainForm.SetAllPartMode(Mode, Part: Byte);
|
|
begin
|
|
SetPartMode(Mode, Part);
|
|
SetPartMode(modeOff, not Part);
|
|
end;
|
|
|
|
procedure TMainForm.DomeOnClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOn, partDome);
|
|
end;
|
|
|
|
procedure TMainForm.DomeOffClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOff, partDome);
|
|
end;
|
|
|
|
procedure TMainForm.DomeAutoClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeAuto, partDome);
|
|
end;
|
|
|
|
procedure TMainForm.BuildingsOnClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOn, partBuildings);
|
|
end;
|
|
|
|
procedure TMainForm.BuildingsOffClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOff, partBuildings);
|
|
end;
|
|
|
|
procedure TMainForm.BuildingsAutoClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeAuto, partBuildings);
|
|
end;
|
|
|
|
procedure TMainForm.StreetOnClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOn, partStreetLight);
|
|
end;
|
|
|
|
procedure TMainForm.StreetOffClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOff, partStreetLight);
|
|
end;
|
|
|
|
procedure TMainForm.StreetAutoClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeAuto, partStreetLight);
|
|
end;
|
|
|
|
procedure TMainForm.OfficeOnClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOn, partOfficeLight);
|
|
end;
|
|
|
|
procedure TMainForm.OfficeOffClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeOff, partOfficeLight);
|
|
end;
|
|
|
|
procedure TMainForm.OfficeAutoClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeAuto, partOfficeLight);
|
|
end;
|
|
|
|
function TMainForm.Parts: Byte;
|
|
begin
|
|
Result:=0;
|
|
if Dome.Checked then Result := Result or partDome;
|
|
if Buildings.Checked then Result := Result or partBuildings;
|
|
if Street.Checked then Result := Result or partStreetLight;
|
|
if Office.Checked then Result := Result or partOfficeLight;
|
|
end;
|
|
|
|
procedure TMainForm.AutoModeClick(Sender: TObject);
|
|
begin
|
|
SetAllPartMode(modeAuto, Parts);
|
|
end;
|
|
|
|
procedure TMainForm.StaticModeClick(Sender: TObject);
|
|
begin
|
|
SetAllPartMode(modeOn, Parts);
|
|
end;
|
|
|
|
procedure TMainForm.AutoClick(Sender: TObject);
|
|
begin
|
|
SetPartMode(modeAuto, partAll);
|
|
end;
|
|
|
|
procedure TMainForm.DomeColorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if SelectColor(DomeColor.Brush, DomeEdit) then
|
|
begin
|
|
SetColor(colorDome, DomeColor.Brush);
|
|
SetPartMode(modeOn, partDome);
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.RoomColor1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if SelectColor(RoomColor1.Brush, RoomEdit1) then
|
|
SetColor(colorRoom1, RoomColor1.Brush);
|
|
end;
|
|
|
|
procedure TMainForm.RoomColor2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if SelectColor(RoomColor2.Brush, RoomEdit2) then
|
|
SetColor(colorRoom2, RoomColor2.Brush);
|
|
end;
|
|
|
|
procedure TMainForm.EditCopy(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
|
|
begin
|
|
Handled := True;
|
|
with TEdit(Sender) do
|
|
begin
|
|
SelectAll;
|
|
CopyToClipboard;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.ClearClick(Sender: TObject);
|
|
begin
|
|
Floor.Position := 0;
|
|
end;
|
|
|
|
procedure TMainForm.ReconnectClick(Sender: TObject);
|
|
begin
|
|
Socket.Active := False;
|
|
Connect;
|
|
end;
|
|
|
|
end.
|