unit1.pas

RS232串口通讯随书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TComm1, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label3: TLabel;
    txtInput: TEdit;
    cmdCalc: TButton;
    cmdClose: TButton;
    Comm1: TComm;
    cmdClearCom: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    procedure cmdCalcClick(Sender: TObject);
    procedure cmdClearComClick(Sender: TObject);
    procedure cmdCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject);
    Procedure  CheckValue(TotalValue:Single;ShapeNo:Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ReceiveStr:String;
  ReceiveData:Array[0..49] of Single;
  Procedure TimeDelay(DT:DWORD);//延迟函数
implementation

{$R *.DFM}

//以下程序将字符串中的字符送出
procedure TForm1.cmdCalcClick(Sender: TObject);
var
  InputStr:String;
begin
  //命令指定，并加上结尾字符Cr
  InputStr:=Trim(txtInput.Text) + Chr(13);
  Comm1.OutputString(InputStr);//送出数据
end;

//结束程序
procedure TForm1.cmdCloseClick(Sender: TObject);
begin
  Close;
end;

//以下是延迟函数，单位毫秒
Procedure TimeDelay(DT:DWORD);
var
 TT:DWORD;
begin
  //取得现在的Tick值
  TT:=GetTickCount();
  //计算Tick差值是否超过设置值
  while GetTickCount()-TT<DT do
   Application.ProcessMessages; //释放控制权
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //打开通信端口
  Comm1.PortOpen := True;
end;


//清除接收缓冲区
procedure TForm1.cmdClearComClick(Sender: TObject);
begin
  //先不触发事件
  Comm1.RThreshold := 0;
  //送出设置的字符串，此将使得PSIS进入数据服务器
  Comm1.OutputString('SET TYPE'+Chr(13));
  TimeDelay(1000);
  Comm1.DataCount :=0; //清除接收区
  Comm1.RThreshold := 1; //设置接收事件的阀值
end;


procedure TForm1.Comm1ReceiveData(Sender: TObject);
var
 Buf:String;
 DotPos,i,j:Integer;
 tmpSingle:Single;
begin
  Buf := Trim(Comm1.Input);
  ReceiveStr := ReceiveStr + Buf;
  //结尾字符是否已返回
  If Pos('!',ReceiveStr) < 1 Then
   Exit
  Else
   begin
    i := 0;
    Repeat
      //检查逗号的位置
      DotPos := Pos(',',ReceiveStr);
      //数据放进数组
       ReceiveData[i] := StrToFloat(Copy(ReceiveStr,1,DotPos-1));
      //留下未处理的数据
      ReceiveStr := Copy(ReceiveStr,DotPos+1,Length(ReceiveStr)-DotPos);
      i := i+1;
      if (i>49) then Break;
    until (DotPos=0);  //直到找不到逗号
    ReceiveStr := '';
    //接着开始处理灯号
    tmpSingle := 0;
    for j:=0 to 9 do
     begin
      for i:=0 to 4 do
        tmpSingle := tmpSingle + ReceiveData[j*5+i];
      CheckValue(tmpSingle,j);
      tmpSingle := 0;
     end;
   end;
end;

//看看加起来的数值落在那一个范围
Procedure TForm1.CheckValue(TotalValue:Single;ShapeNo:Integer);
var
  C1:DWORD;
begin
   //依照不同的数值，改变颜色
  if (TotalValue<60) then C1 := clWhite;
  if (60<=TotalValue) and (TotalValue<90) then C1 := clGray;
  if (TotalValue>=90) then C1 := clRed;
  case ShapeNo of
   0:Shape1.Brush.Color := C1;
   1:Shape2.Brush.Color := C1;
   2:Shape3.Brush.Color := C1;
   3:Shape4.Brush.Color := C1;
   4:Shape5.Brush.Color := C1;
   5:Shape6.Brush.Color := C1;
   6:Shape7.Brush.Color := C1;
   7:Shape8.Brush.Color := C1;
   8:Shape9.Brush.Color := C1;
   9:Shape10.Brush.Color := C1;
  end;
end;

end.