MMCL/SOURCE/agents/delphi_led_agent/MainForm.pas

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.