demo.pas

电脑控制继电器.可以用远程控制电脑.然后电脑控制继电器控制家电等

unit demo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, SPComm, StdCtrls, Buttons, jpeg, shellapi;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    j1: TCheckBox;
    j2: TCheckBox;
    j3: TCheckBox;
    j4: TCheckBox;
    j5: TCheckBox;
    j6: TCheckBox;
    j7: TCheckBox;
    j8: TCheckBox;
    d1: TCheckBox;
    d2: TCheckBox;
    d3: TCheckBox;
    d4: TCheckBox;
    d5: TCheckBox;
    d6: TCheckBox;
    d7: TCheckBox;
    d8: TCheckBox;
    q1: TCheckBox;
    q2: TCheckBox;
    q3: TCheckBox;
    q4: TCheckBox;
    Button2: TButton;
    q5: TCheckBox;
    q6: TCheckBox;
    q7: TCheckBox;
    q8: TCheckBox;
    comm: TComm;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Panel2: TPanel;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure commReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure j1Click(Sender: TObject);
    procedure d1Click(Sender: TObject);
    procedure q1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Image2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TimeOut: Boolean;
  PData: array[1..4] of Byte; //接收字节缓冲
  ROK: Boolean; //是否要检测返回值标识
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := false;
  comm.WriteCommData(PAnsiChar(char($61)+char($4)+char($4)+char($61)),4);  //发送内置测试命令字
  Timer1.Interval := 5000 ;
  Timer1.Enabled := true;  //设超时检测时间，并打开时钟
  ROK := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  comm.StartComm;   //开串口
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  comm.StopComm;  //关串口
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false; //超时，关时钟
  Application.MessageBox('超时，系统有故障','出错');
  Button1.Enabled := true;
  ROK := false;
end;

procedure TForm1.commReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
begin
  if ROK then
    begin
      Move(Buffer^,PData,4);
      if (PData[1]=$61) and (PData[2]=$4) and (PData[3]=$4) and (PData[4]=$61) then
        begin
          Timer1.Enabled := false;
          Button1.Enabled := true;
          Application.MessageBox( PAnsichar('内置测试成功，返回字节为'+IntToHex(Pdata[1],2)+IntToHex(Pdata[2],2)
            +IntToHex(Pdata[3],2)+IntToHex(Pdata[4],2)),'成功');
        end;
      ROK := false;
    end;
end;

procedure TForm1.j1Click(Sender: TObject);
var
  outdata: byte;
begin
if not ROK then //内置测试没有完成，不允许发送字串
begin
  outdata := 255;
  if j1.Checked then outdata := outdata-1;
  if j2.Checked then outdata := outdata-2;
  if j3.Checked then outdata := outdata-4;
  if j4.Checked then outdata := outdata-8;
  if j5.Checked then outdata := outdata-16;
  if j6.Checked then outdata := outdata-32;
  if j7.Checked then outdata := outdata-64;
  if j8.Checked then outdata := outdata-128;
  comm.WriteCommData(PAnsiChar(char($61)+char($0)+char(outdata)+char($61)),4);  //发送命令字
end;
end;

procedure TForm1.d1Click(Sender: TObject);
var
  outdata: byte;
begin
if not ROK then //内置测试没有完成，不允许发送字串
begin
  outdata := 255;
  if d1.Checked then outdata := outdata-1;
  if d2.Checked then outdata := outdata-2;
  if d3.Checked then outdata := outdata-4;
  if d4.Checked then outdata := outdata-8;
  if d5.Checked then outdata := outdata-16;
  if d6.Checked then outdata := outdata-32;
  if d7.Checked then outdata := outdata-64;
  if d8.Checked then outdata := outdata-128;
  comm.WriteCommData(PAnsiChar(char($61)+char($1)+char(outdata)+char($61)),4);  //发送命令字
end;
end;

procedure TForm1.q1Click(Sender: TObject);
var
  outdata: byte;
begin
if not ROK then //内置测试没有完成，不允许发送字串
begin
  outdata := 255;
  if q1.Checked then outdata := outdata-1;
  if q2.Checked then outdata := outdata-2;
  if q3.Checked then outdata := outdata-4;
  if q4.Checked then outdata := outdata-8;
  if q5.Checked then outdata := outdata-16;
  if q6.Checked then outdata := outdata-32;
  if q7.Checked then outdata := outdata-64;
  if q8.Checked then outdata := outdata-128;
  comm.WriteCommData(PAnsiChar(char($61)+char($2)+char(outdata)+char($61)),4);  //发送命令字
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if not ROK then //内置测试没有完成，不允许发送字串
begin
  comm.WriteCommData(PAnsiChar(char($61)+char($3)+char($3)+char($61)),4);  //发送命令字
  ROK := true; //防止checked改变而触发j,d,q选项框的onclick事件
  j1.Checked := false;
  j2.Checked := false;
  j3.Checked := false;
  j4.Checked := false;
  j5.Checked := false;
  j6.Checked := false;
  j7.Checked := false;
  j8.Checked := false;
  d1.Checked := false;
  d2.Checked := false;
  d3.Checked := false;
  d4.Checked := false;
  d5.Checked := false;
  d6.Checked := false;
  d7.Checked := false;
  d8.Checked := false;
  q1.Checked := false;
  q2.Checked := false;
  q3.Checked := false;
  q4.Checked := false;
  q5.Checked := false;
  q6.Checked := false;
  q7.Checked := false;
  q8.Checked := false;
  ROK := false;
end;
end;

procedure TForm1.Image1Click(Sender: TObject);
 Var St:Array[0..255] of char;
begin
  ShellExecute(Handle,'open',StrPCopy(St,'http://www.cdle.net'),nil,nil,SW_SHOW);
end;


procedure TForm1.Image2Click(Sender: TObject);
 Var St:Array[0..255] of char;
begin
  ShellExecute(Handle,'open',StrPCopy(St,'http://www.radio.com.cn'),nil,nil,SW_SHOW);
end;

end.