unit uMain; 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.