📄 idset.pas

📁 使用Delphi 6.0开发用于控制空调的程序
💻 PAS
字号:
unit IDSet;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,SU,RSU, ComCtrls;

type
  TfrmIDSet = class(TForm)
    lbl1: TLabel;
    lbl4: TLabel;
    edtSetpw: TEdit;
    btnSetPW: TButton;
    btnSetId: TButton;
    lbl5: TLabel;
    edtSetID: TEdit;
    btnSetNowTime: TButton;
    lbl6: TLabel;
    lbl7: TLabel;
    lbl8: TLabel;
    lbl9: TLabel;
    btnTSPT: TButton;
    lbl10: TLabel;
    btnDialNum: TButton;
    lbl11: TLabel;
    btnReDialNum: TButton;
    lbl12: TLabel;
    cbbAutoMach: TComboBox;
    btnAutoMachine: TButton;
    lbl13: TLabel;
    btnAutoRT: TButton;
    lbl14: TLabel;
    btnMinRGNum: TButton;
    lbl2: TLabel;
    lbl3: TLabel;
    cbbMinGRNum: TComboBox;
    cbbDialNum: TComboBox;
    cbbReDialNum: TComboBox;
    cbbAutoRT: TComboBox;
    cbbNTHour: TComboBox;
    cbbNTMinu: TComboBox;
    cbbTSPTHour: TComboBox;
    cbbTSPTMinu: TComboBox;
    grpDiagling: TGroupBox;
    lbl15: TLabel;
    lbl16: TLabel;
    lbl17: TLabel;
    lbl18: TLabel;
    lbl19: TLabel;
    lbl20: TLabel;
    chkRunModel: TCheckBox;
    chkHJAbal: TCheckBox;
    chkCommAbal: TCheckBox;
    chkFilter: TCheckBox;
    chkAbal: TCheckBox;
    chkTSRP: TCheckBox;
    btnDialging: TButton;
    grpSetCenterTELNO: TGroupBox;
    lbl21: TLabel;
    edtTELN: TEdit;
    btnSetCenterTELNO: TButton;
    statIDSet: TStatusBar;
    btn1: TButton;
    edt1: TEdit;
    procedure btnSetIdClick(Sender: TObject);
    procedure btnIDIdClick(Sender: TObject);
    procedure btnPWIDClick(Sender: TObject);
    procedure btnSetPWClick(Sender: TObject);
    procedure btnSetNowTimeClick(Sender: TObject);
    procedure btnTSPTClick(Sender: TObject);
    procedure btnAutoMachineClick(Sender: TObject);
    procedure btnAutoRTClick(Sender: TObject);
    procedure btnMinRGNumClick(Sender: TObject);
    procedure btnDialNumClick(Sender: TObject);
    procedure btnReDialNumClick(Sender: TObject);
    procedure btnDialgingClick(Sender: TObject);
    procedure btnSetCenterTELNOClick(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmIDSet: TfrmIDSet;

implementation

{$R *.dfm}

uses
  main;

function hex(c:char):Integer;
var
   x:integer;
begin
    if c='' then
       x:=0
    else if(Ord(c)>=ord('0'))and (Ord(c)<=ord('9')) then
        x:=Ord(c)-Ord('0')
    else if(Ord(c)>=ord('a'))and (Ord(c)<=ord('f')) then
        x:=Ord(c)-Ord('a')+10
    else if(Ord(c)>=ord('A'))and (Ord(c)<=ord('F')) then
        x:=Ord(c)-Ord('A')+10
    else
     x:=-1;
    Result:=x;
end;
function BinToChar(b:string):string ;
var
  i:Integer;
  strHex:string;
begin
  i := StrToInt(b[1])*2*2*2 + StrToInt(b[2])*2*2 + StrToInt(b[3])*2 + StrToInt(b[4]);
  strHex := IntToHex(i,1);
  Result := strHex ;
end;
function BinToHex(b:string ):string ;
var
  strTemp1,
  strtemp2:string;

begin
   strTemp1 := BinToChar(Copy(b,1,4));
   strtemp2 := BinToChar(Copy(b,5,4));
   Result := strTemp1 + strTemp2;
end;
procedure TfrmIDSet.btnSetIdClick(Sender: TObject);
var
  strTemp,
  strSendComm:string;
  SUSend:TSU;
begin
   strTemp := Trim(edtSetID.Text);
   if Length(strTemp) <> 16 then
   begin
      ShowMessage('请输入16位数字，不足的用字符F 来补充！');
      Exit;
   end
   else
   begin
      SUSend := TSU.Create;
      try
        SUSend.SetID(strTemp);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
      finally
        SUSend.Free;
      end;
   end;  
end;

procedure TfrmIDSet.btnIDIdClick(Sender: TObject);
var
  SUSend:TSU;
  strSendComm:string;

begin
  SUSend := TSU.Create;
  try  
    SUSend.IDId;
    strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
  finally
    SUSend.Free;
  end;
  Sleep(1000);
  //edtID.Text := main.frmain.ReceBuffer;
end;

procedure TfrmIDSet.btnPWIDClick(Sender: TObject);
//var
 // SUSend:TSU;
begin
//  SUSend := TSU.Create;
//  if Length(edtPW.Text) <> 8 then
//    ShowMessage('输入的密码必须为8位，请重新输入！')
//  else
//  begin
//     try
//       SUSend.PassWordID(edtPW.Text);
//     finally
//       SUSend.Free;
//     end;
//  end;

end;

procedure TfrmIDSet.btnSetPWClick(Sender: TObject);
var
  //strTemp:string;
  SUSend:TSU;
  strSendComm:string;
begin
  if Length(edtSetpw.Text) <> 8 then
    ShowMessage('输入的密码必须为8位，请重新输入！')
  else
  begin
     SUSend := TSU.Create;
     try
       SUSend.SetPassWord(edtSetpw.Text);
       strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
     finally
       SUSend.Free;
     end;
  end;
end;

procedure TfrmIDSet.btnSetNowTimeClick(Sender: TObject);
var
  strTempH,strTempM:string;
  iH,iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   iH := StrToInt(cbbNTHour.Text);
   iM := StrToInt(cbbNTMinu.Text);
   SUSend := TSU.Create;
   try
        strTempH := IntToHex(iH,2);
        strTempM := IntToHex(iM,2);
        SUSend.SetNowTime(strTempH,strTempM);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;
end;

procedure TfrmIDSet.btnTSPTClick(Sender: TObject);
var
  strTempH,strTempM:string;
  iH,iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   iH := StrToInt(cbbTSPTHour.Text);
   iM := StrToInt(cbbTSPTMinu.Text);
   SUSend := TSU.Create;
   try
        strTempH := IntToHex(iH,2);
        strTempM := IntToHex(iM,2);
        SUSend.SetTimingSendPaperTime(strTempH,strTempM);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;

end;

procedure TfrmIDSet.btnAutoMachineClick(Sender: TObject);
var
  //strTemp,
  strTempM:string;
  //iH,iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   if  cbbAutoMach.Text = '有' then
       strTempM :='1'
   else
   if cbbAutoMach.Text = '无' then
       strTempM :='0';
   SUSend := TSU.Create;
   try
        SUSend.SetAutoMachine(strTempM);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;                  
end;

procedure TfrmIDSet.btnAutoRTClick(Sender: TObject);
var
  //strTemp,
  strTemp,
  strHex:string;
  //iH,
  iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := cbbAutoRT.Text;
   iM := StrToInt(strTemp);
   strHex := IntToHex(iM,2);
   ShowMessage(strHex);
   SUSend := TSU.Create;
   try
        SUSend.SetAutoRunTime(strHex);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;
end;

procedure TfrmIDSet.btnMinRGNumClick(Sender: TObject);
var
  strTemp  :string;
  //strHex:string;
  //iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := cbbMinGRNum.Text;
   //iM := StrToInt(strTemp);
   //strHex := IntToHex(iM,2);
   ShowMessage(strTemp);
   SUSend := TSU.Create;
   try
        SUSend.SetMinRunGuranteeNum(strTemp);

        strSendComm := SUSend.GetCOmmand;
        ShowMessage(strsendcomm);
        ShowMessage( SUSend.GetErrorInfo);
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;

end;

procedure TfrmIDSet.btnDialNumClick(Sender: TObject);
var
  strTemp,
  strHex:string;
  iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := cbbDialNum.Text;
   iM := StrToInt(strTemp);
   strHex := IntToHex(iM,1);
   ShowMessage(strHex);
   ShowMessage(IntToStr(Length(strHex)));
   SUSend := TSU.Create;
   try
        SUSend.SetDialingNum(strHex);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;

end;

procedure TfrmIDSet.btnReDialNumClick(Sender: TObject);
var
  strTemp,
  strHex:string;
  iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := cbbReDialNum.Text;
   iM := StrToInt(strTemp);
   strHex := IntToHex(iM,2);
   ShowMessage(strHex);
   SUSend := TSU.Create;
   try
        SUSend.SetReDialingNum(strHex);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;
end;

procedure TfrmIDSet.btnDialgingClick(Sender: TObject);
var
  strTemp,
  strHex:string;
 // iM:Integer;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := '00';
   if chkRunModel.Checked then
      strTemp := strTemp +'1'
   else strTemp := strTemp +'0';
   if chkHJAbal.Checked then
      strTemp := strTemp + '1'
   else strTemp := strTemp + '0';
   if chkCommAbal.Checked then
      strTemp := strTemp +'1'
   else strTemp := strTemp +'0';
   if chkFilter.Checked then
      strTemp := strTemp + '1'
   else strTemp := strTemp + '0';
   if chkAbal.Checked then
      strTemp := strTemp +'1'
   else strTemp := strTemp +'0';
   if chkTSRP.Checked then
      strTemp := strTemp + '1'
   else strTemp := strTemp + '0';
   strHex := BinToHex(strTemp);
  // ShowMessage(strTemp);
  // ShowMessage('十六进制：  '+strHex);
   SUSend := TSU.Create;
   try
        SUSend.SetDiagling(strHex);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;    
end;

procedure TfrmIDSet.btnSetCenterTELNOClick(Sender: TObject);
var
  strTemp:string;
  SUSend:TSU;
  strSendComm:string;
begin
   strTemp := edtTELN.Text;
   if Length(strTemp) <> 30 then
   begin
      ShowMessage('请输入30位TEL NO,不足30位，未使用区域必须设定为F！当前输入的位数为：' +
      IntToStr(Length(strTemp)) + '位');
      Exit;
   end;
   SUSend := TSU.Create;
   try
        SUSend.SetCenterTELNo(strTemp);
        strSendComm := SUSend.GetCOmmand;
        try
          if not main.frmain.Spcomm1.PortOpen  then
              main.frmain.Spcomm1.StartComm;
          main.frmain.Spcomm1.WriteCommData( PChar(strSendComm),Length(strSendComm));
        except
          ShowMessage('命令发送失败！');
        end;
   finally
        SUSend.Free;
   end;

end;

function BCC(strBCC: string): string;
var
  i,strSum:Integer;
  strResult:string;
begin
   strSum := 0;
   for i := 1 to Length(strBCC) do
   begin
     strSum := strSum + Ord(strBCC[i]);
   end;
   strResult := IntToHex((strSum and $0F),1);
   Result := strResult;
end;
procedure TfrmIDSet.btn1Click(Sender: TObject);
var
  strTemp:string;
begin
   if not Main.frmain.Spcomm1.PortOpen  then
      Main.frmain.Spcomm1.StartComm;
   //strTemp := #02 + '230' + #03;  //300
   // strTemp := #02 + '210' + #03;  //210
    strTemp := #02 + edt1.Text + #03;  //210
   strTemp := strTemp + BCC(strTemp);
    Main.frmain.Spcomm1.WriteCommData( PChar(strTemp),Length(strTemp));
end;

end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -