MMCL/agents/delphi_led_agent/MainForm.pas
2026-09-04 11:24:42 +09:00

214 lines
5.8 KiB
ObjectPascal

unit MainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TfrmMain = class(TForm)
GroupBox1: TGroupBox;
btnRedOn: TButton;
btnRedBlink: TButton;
btnRedOff: TButton;
btnYellowOn: TButton;
btnYellowBlink: TButton;
btnYellowOff: TButton;
btnGreenOn: TButton;
btnGreenBlink: TButton;
btnGreenOff: TButton;
btnBlueOn: TButton;
btnBlueBlink: TButton;
btnBlueOff: TButton;
btnWhiteOn: TButton;
btnWhiteBlink: TButton;
btnWhiteOff: TButton;
GroupBox2: TGroupBox;
btnSoundOff: TButton;
btnSound1: TButton;
btnSound2: TButton;
btnSound3: TButton;
btnSound4: TButton;
btnSound5: TButton;
Label1: TLabel;
edtIP1: TEdit;
edtIP2: TEdit;
edtIP3: TEdit;
edtIP4: TEdit;
GroupBox3: TGroupBox;
edtPort: TEdit;
rgModel: TRadioGroup;
btnStatRead: TButton;
btnReset: TButton;
btnExit: TButton;
GroupBox4: TGroupBox;
lbStatus: TListBox;
procedure FormCreate(Sender: TObject);
procedure btnLampClick(Sender: TObject);
procedure btnSoundClick(Sender: TObject);
procedure btnStatReadClick(Sender: TObject);
procedure btnResetClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
private
{ Private declarations }
c_pIdata: array[0..14] of Byte;
c_pIpadd: array[0..3] of Byte;
function SendCommand: Boolean;
procedure LogMessage(const Msg: string);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
function Tcp_Qu_RW(iPort: Integer; var pbIp: Byte; var pbData: Byte): Boolean; stdcall; external 'Qtvc_dll.dll';
implementation
{$R *.dfm}
const
C_lampoff = 0;
C_lampon = 1;
C_lampblink = 2;
D_not = 100;
procedure TfrmMain.FormCreate(Sender: TObject);
var
i: Integer;
begin
// Initialize data
for i := 0 to 14 do c_pIdata[i] := D_not;
c_pIdata[0] := 1; // 1-write, 0-read
c_pIdata[1] := 0; // type default
end;
procedure TfrmMain.LogMessage(const Msg: string);
begin
lbStatus.Items.Insert(0, FormatDateTime('hh:nn:ss', Now) + ' ' + Msg);
end;
function TfrmMain.SendCommand: Boolean;
var
iPort: Integer;
begin
Result := False;
try
c_pIpadd[0] := StrToIntDef(edtIP1.Text, 192);
c_pIpadd[1] := StrToIntDef(edtIP2.Text, 168);
c_pIpadd[2] := StrToIntDef(edtIP3.Text, 200);
c_pIpadd[3] := StrToIntDef(edtIP4.Text, 114);
iPort := StrToIntDef(edtPort.Text, 20000);
// Get model select
c_pIdata[1] := rgModel.ItemIndex;
Result := Tcp_Qu_RW(iPort, c_pIpadd[0], c_pIdata[0]);
if Result then
LogMessage('[Success send]')
else
LogMessage('[Send Error]');
except
on E: Exception do
LogMessage('[Error] ' + E.Message);
end;
end;
procedure TfrmMain.btnLampClick(Sender: TObject);
var
Btn: TButton;
ColorIdx: Integer; // 2:Red, 3:Yellow, 4:Green, 5:Blue, 6:White
Action: Integer;
i: Integer;
begin
// Reset all to D_not before setting the specific one
for i := 2 to 6 do c_pIdata[i] := D_not;
c_pIdata[7] := D_not; // Keep sound unchanged
c_pIdata[0] := 1; // Write mode
Btn := Sender as TButton;
if (Btn = btnRedOn) or (Btn = btnRedBlink) or (Btn = btnRedOff) then ColorIdx := 2
else if (Btn = btnYellowOn) or (Btn = btnYellowBlink) or (Btn = btnYellowOff) then ColorIdx := 3
else if (Btn = btnGreenOn) or (Btn = btnGreenBlink) or (Btn = btnGreenOff) then ColorIdx := 4
else if (Btn = btnBlueOn) or (Btn = btnBlueBlink) or (Btn = btnBlueOff) then ColorIdx := 5
else if (Btn = btnWhiteOn) or (Btn = btnWhiteBlink) or (Btn = btnWhiteOff) then ColorIdx := 6
else Exit;
if Btn.Caption = 'ON' then Action := C_lampon
else if Btn.Caption = 'ON/OFF' then Action := C_lampblink
else Action := C_lampoff;
c_pIdata[ColorIdx] := Action;
SendCommand;
end;
procedure TfrmMain.btnSoundClick(Sender: TObject);
var
Btn: TButton;
i: Integer;
begin
for i := 2 to 6 do c_pIdata[i] := D_not; // Keep lamps unchanged
c_pIdata[0] := 1; // Write mode
Btn := Sender as TButton;
if Btn = btnSoundOff then c_pIdata[7] := 0
else if Btn = btnSound1 then c_pIdata[7] := 1
else if Btn = btnSound2 then c_pIdata[7] := 2
else if Btn = btnSound3 then c_pIdata[7] := 3
else if Btn = btnSound4 then c_pIdata[7] := 4
else if Btn = btnSound5 then c_pIdata[7] := 5
else c_pIdata[7] := D_not;
SendCommand;
end;
procedure TfrmMain.btnStatReadClick(Sender: TObject);
var
iPort: Integer;
Success: Boolean;
StatusStr: string;
begin
try
c_pIpadd[0] := StrToIntDef(edtIP1.Text, 192);
c_pIpadd[1] := StrToIntDef(edtIP2.Text, 168);
c_pIpadd[2] := StrToIntDef(edtIP3.Text, 200);
c_pIpadd[3] := StrToIntDef(edtIP4.Text, 114);
iPort := StrToIntDef(edtPort.Text, 20000);
c_pIdata[0] := 0; // 0-read
Success := Tcp_Qu_RW(iPort, c_pIpadd[0], c_pIdata[0]);
if Success then
begin
StatusStr := '[Read Success] ';
if c_pIdata[2] = 0 then StatusStr := StatusStr + 'R-OFF ' else if c_pIdata[2] = 1 then StatusStr := StatusStr + 'R-ON ' else if c_pIdata[2] = 2 then StatusStr := StatusStr + 'R-BLINK ';
if c_pIdata[3] = 0 then StatusStr := StatusStr + 'Y-OFF ' else if c_pIdata[3] = 1 then StatusStr := StatusStr + 'Y-ON ' else if c_pIdata[3] = 2 then StatusStr := StatusStr + 'Y-BLINK ';
if c_pIdata[4] = 0 then StatusStr := StatusStr + 'G-OFF ' else if c_pIdata[4] = 1 then StatusStr := StatusStr + 'G-ON ' else if c_pIdata[4] = 2 then StatusStr := StatusStr + 'G-BLINK ';
LogMessage(StatusStr);
end
else
LogMessage('[Read Error]');
except
on E: Exception do
LogMessage('[Error] ' + E.Message);
end;
end;
procedure TfrmMain.btnResetClick(Sender: TObject);
begin
lbStatus.Clear;
end;
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
Close;
end;
end.