u_comlink.pas

这是一个60吨地磅称量系统

unit U_ComLink;


interface

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

type
  TF_ComLink = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    scan: TTimer;
    RadioGroup1: TRadioGroup;
    procedure SendStr;
    function  ReceiveStr:String;
    procedure Open;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckRecv;
    procedure SendRead;
    procedure scanTimer(Sender: TObject);
     procedure RadioGroup1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    ComErr: Boolean;
    Port, StartID, EndID, MemAddr: Integer;
    DataValue: Double;
  end;

var
  F_ComLink: TF_ComLink;
  ShowOk: Boolean;
  ID, ScanTimes, TimeOut: Integer;
  StrSend, StrRecv,str: String;
  //DataValue : Extended;
implementation

{$R *.DFM}

uses U_UTIL, PComm;

procedure TF_ComLink.SendStr;
var
  i: Integer;
  Strs : array [1..30] of Char;
begin
  Edit1.Text:=StrSend;
  StrRecv:='';
  TimeOut:=0;
  for i:=1 to Length(StrSend) do Strs[i]:=StrSend[i];
  sio_write(Port,@Strs,Length(StrSend));
  sio_write(Port,@Strs,7);
  CheckRecv;
end;

function TF_ComLink.ReceiveStr:String;
var
   ret, i:Integer;
   Datas : array [1..22] of Char;
begin
   Result:='';
   ret:=sio_iqueue(Port);
   if ret>0 then
   begin
      if ret>20 then ret:=20;
      sio_read(Port,@Datas,ret);
      for i:=1 to ret do
      begin
         Result:=Result+Datas[i];
      end;
   end;
end;

procedure TF_ComLink.Open;
var
  ret:Integer;
begin
   Port:=RadioGroup1.ItemIndex+1;
   
  ret := sio_open(Port);
  if ret <> SIO_OK then
  begin
    MessageDlg('通信端口 COM'+IntToStr(Port)+'不存在或在使用中',mtWarning,[mbOK],0);
    Exit;
  end;
  sio_ioctl(Port,B9600,P_EVEN or BIT_7 or STOP_1);
  SendRead;
end;

procedure TF_ComLink.FormCreate(Sender: TObject);
begin
  ShowOk:=False;
  Port:=RadioGroup1.ItemIndex+1;
  ScanTimes:=10;
  TimeOut:=0;
  ComErr:=False;
  StrSend:='';
  StrRecv:='';

  StartID:=2;
  EndID:=2;
  MemAddr:=0;
  ID:=StartID-1;
end;

procedure TF_ComLink.FormShow(Sender: TObject);
begin
        if ShowOk=True then Exit;
  ShowOk:=True;
  Open;
  ScanTimer(Sender);
end;

procedure TF_ComLink.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   sio_close(Port);
end;

procedure TF_ComLink.CheckRecv;
var
  i, LenSend, LenRecv:Integer;
begin
  TimeOut:=TimeOut+1;
  StrRecv:=StrRecv+ReceiveStr;
                 // StrRecv:=';?'+'11111.1kg'+CHR(13)+CHR(10);
  Edit2.Text:=Copy(StrRecv,1,16);
  LenSend:=Length(StrSend);
  LenRecv:=Length(StrRecv);

  if (LenRecv<12) then Exit;
  i:=1;
  while i<LenRecv do
  begin
    if Copy(StrRecv,i,LenSend)=StrSend then
    begin
      StrRecv:=Copy(StrRecv,i+LenSend,LenRecv-LenSend-i+1);
      LenRecv:=Length(StrRecv);
      i:=LenRecv+1;
    end
    else
    begin
      i:=i+1;
    end;
  end;
  if  Copy(StrRecv,2,1)=')' then
  begin
      Str:=Copy(StrRecv,5,6)+'.'+Copy(StrRecv,11,1); // x=5 y=7
       Edit3.Text:=FloatToStr(StrToFloat(Str));
         end;

end;

procedure TF_ComLink.SendRead;
begin
  ID:=ID+1;
  if ID>EndID then ID:=StartID;
  StrSend:=')'+CHR(13);    //')'
  SendStr;

end;

procedure TF_ComLink.scanTimer(Sender: TObject);
begin
    if ID<StartID then ID:=StartID;
  if StrSend<>'' then CheckRecv;
  if TimeOut>ScanTimes then
  begin
    StrSend:='';
    ComErr:=True;
  end;
  if StrSend='' then SendRead;
end;



procedure TF_ComLink.RadioGroup1Click(Sender: TObject);
begin
   sio_close(Port);
  open;
  Edit3.Text:='';
end;

end.