unit1.pas

此文章是关于Delphi串口通信类的一些文章和源代码,它是单片机串口通讯较好的上位机设计的参考!

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;
  ReceiveStr:String;
  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 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);
var
  Buf:String;
begin
  //先不触发事件
  Comm1.RThreshold := 0;
  //送出设置的字符串，此将使得PSIS进入数据服务器
  Comm1.OutputString('SET TYPE 3'+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 ; //指定范围
end;


procedure TForm1.Comm1ReceiveData(Sender: TObject);
var
 Buf:String;
 DotPos,i,j:Integer;
 tmpSingle,MaxValue,MinValue:Single;
 pt:TPoint;
begin
  Buf := Trim(Comm1.Input);
  ReceiveStr := ReceiveStr + Buf;
  //结尾字符是否已返回
  If Pos('!',ReceiveStr) < 1 Then
   Exit
  Else
   begin
    i := 0;
    Repeat
      //检查逗号的位置
      DotPos := Pos(',',ReceiveStr);
      if DotPos=0 then Break;
      //数据放进数组
       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 := '';
    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;

end.