unit1.pas

RS232串口通讯随书源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label3: TLabel;
    cmdCalc: TButton;
    cmdClose: TButton;
    Comm1: TComm;
    cmdClearCom: TButton;
    Pic1: TPaintBox;
    procedure cmdCalcClick(Sender: TObject);
    procedure cmdClearComClick(Sender: TObject);
    procedure cmdCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject);
    procedure Pic1Paint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  rt:TRect;
  ByteCount:Integer;
  ReceiveByte:Array[0..4095] of Byte;
  ReceiveData:Array[0..49] of Single;
  PointArray:array[0..49] of TPoint;
  Procedure TimeDelay(DT:DWORD);//延迟函数
implementation

{$R *.DFM}

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

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

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


//清除接收缓冲区
procedure TForm1.cmdClearComClick(Sender: TObject);
var
  Buf:String;
begin
  //先不触发事件
  Comm1.RThreshold := 0;
  //送出设置的字符串，此将使得PSIS进入数据服务器
  Comm1.OutputString('SET TYPE 4'+Chr(13));
  TimeDelay(1000);
  Buf := Comm1.Input ; //接收返回字符串
  if Pos('Data',Buf)<1 then
  begin
    ShowMessage('设置发生错误!请检查PSIS');
    Exit;
  end;
  Comm1.DataCount :=0; //清除接收区
  Comm1.RThreshold := 1; //设置接收事件的阀值
  //设置绘图方式
  Pic1.canvas.Pen.Mode:=pmCopy;
  //绘出边框
  Pic1.Canvas.Rectangle(0,0,Pic1.Width ,Pic1.Height);
  rt:=pic1.ClientRect ; //指定范围
  ByteCount := 0; //长度清为0
  cmdCalc.Enabled := True; //激活传送命令的按钮
end;


procedure TForm1.Comm1ReceiveData(Sender: TObject);
var
 Buf:String;
 i,j,Count:Integer;
 DataPT:PByte;
 MaxValue,MinValue:Single;
 FindEnd:Integer;
 pt:TPoint;
begin
  //取得二进制数据笔数及地址
  Count := Comm1.ReadInputByte(DataPT);
  Dec(DataPT); //地址减1
  for i:=0 to Count-1 do
   begin
    inc(DataPT);  //地址加1
    //指定到数组
    ReceiveByte[ByteCount+i]:=DataPT^;
   end;
   //字节数组索引增加 
   ByteCount := ByteCount + Count ;
  //字节数是否足够?
   FindEnd := 0;
   if ByteCount>=100 then FindEnd := 1;
  If FindEnd <> 1 Then
   Exit
  Else
   begin
     //数据转换
    j := 0;
    for i := 0 to 49 do
    begin
      //组合数据
      Buf := IntToStr(ord(ReceiveByte[j])) + '.' + IntToStr(Ord(ReceiveByte[j+1]));
      //转换为单精度数值
      ReceiveData[i] := StrToFloat(Buf);
      j := j+2;
    end;
    Comm1.DataCount :=0; //清除接收区
    ByteCount := 0;    //计数归零
    MaxValue := -9999;
    MinValue := 9999;
    //算出最大及最小值
    for i := 0 to 49 do
       if ReceiveData[i]>MaxValue then MaxValue := ReceiveData[i];
    for i := 0 to 49 do
       if ReceiveData[i]<MinValue then MinValue := ReceiveData[i];
    //接着开始处理图形,将数据存进PT数组中
    for i:=0 to 49 do
    begin
      pt.x:=Trunc(rt.Right /49*i);
      pt.y:=Trunc(rt.bottom/(MaxValue-MinValue)*ReceiveData[i]);
      PointArray[i]:=pt;
    end;
    Pic1Paint(Sender);
   end;
end;


procedure TForm1.Pic1Paint(Sender: TObject);
begin
    //绘出边框
    Pic1.Canvas.Pen.Color := clBlack;
    Pic1.Canvas.Brush.Color := clWhite;
    Pic1.Canvas.Rectangle(rt);
    //绘线
    Pic1.Canvas.Pen.Color := clRed;
    pic1.Canvas.Polyline(PointArray);

end;

Procedure TimeDelay(DT:DWORD);
var
 TT:DWORD;
begin
  //取得现在的Tick值
  TT:=GetTickCount();
  //计算Tick差值是否超过设定值
  while GetTickCount()-TT<DT do
   Application.ProcessMessages; //释放控制权
end;


end.