u_comtest.pas

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

unit U_comtest;


interface

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

type
  TF_COMTest = class(TForm)
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    scan: TTimer;
    RadioGroup1: TRadioGroup;
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    LWght: TMenuItem;
    Wght: TMenuItem;
    SysExit: TMenuItem;
    password: TMenuItem;
    pwdchg: TMenuItem;
    N4: TMenuItem;
    N2: TMenuItem;
    system: TMenuItem;
    pwdreg: TMenuItem;
    cap: TMenuItem;
    Panel1: TPanel;
    Hdies: TButton;
    Search: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    RePrn: TMenuItem;
    N8: TMenuItem;
    procedure Exitprg;
    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);
    procedure LWghtClick(Sender: TObject);
    procedure WghtClick(Sender: TObject);
    procedure SysExitClick(Sender: TObject);
    procedure pwdchgClick(Sender: TObject);
    procedure pwdregClick(Sender: TObject);
    procedure capClick(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure SearchClick(Sender: TObject);
    procedure ClTableClick(Sender: TObject);
    procedure CLTable2Click(Sender: TObject);
    procedure sysClick(Sender: TObject);
    procedure HdiesClick(Sender: TObject);
    procedure systemClick(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure RePrnClick(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure  ShutDown;


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

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

{$R *.DFM}

uses U_UTIL, PComm,U_comwet,U_ComLwet,U_Gloat, u_pass, u_datetimer,U_SysHighSet,
  u_GloatRecord, mmsystem;

procedure TF_ComTest.Exitprg;
begin
  if MessageDlg('  确定关闭程序吗 ？   ',mtConfirmation,[mbYes,mbNo],0)=mrYes then
  begin
    FileSetAttr('PASSWORD.DBF',3);
    sio_close(Port); //com  port close;
     Close;
    Application.Terminate;
  end;
  end;


procedure TF_COMTest.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_COMTest.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_COMTest.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_COMTest.FormCreate(Sender: TObject);
begin
  ShowOk:=False;
  Port:=RadioGroup1.ItemIndex+1;
  ScanTimes:=0;
  TimeOut:=0;
  ComErr:=False;
  StrSend:='';
  StrRecv:='';

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

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

end;

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

end;

procedure TF_COMTest.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_COMTest.SendRead;
begin
  ID:=ID+1;
  if ID>EndID then ID:=StartID;
  StrSend:=')'+CHR(13);    //')'
  SendStr;

end;

procedure TF_COMTest.scanTimer(Sender: TObject);
begin
// Randomize;                   /////////////////////////////////调试用
// Edit3.Text:=IntToStr(Random(3000+96999));   /////////////////////////////////调试用
 if Edit3.Text='' then Edit3.Text:='00000000' ;

    F_DATETIMER.Labeldate.caption:=formatdatetime('yyyy"年"mm"月"dd"日" ',NOW);

 F_DATETIMER.Labeltime.caption:=formatdatetime('hh:nn:ss dddd',NOW);

    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_COMTest.RadioGroup1Click(Sender: TObject);
begin
   sio_close(Port);
  open;
  Edit3.Text:='000000';
end;

procedure TF_COMTest.LWghtClick(Sender: TObject);
begin
   SndPlaySound('Music',SND_ASYNC);    //声音播放
   F_ComLwet.Show;
end;

procedure TF_COMTest.WghtClick(Sender: TObject);
begin
      SndPlaySound('Music',SND_ASYNC);    //声音播放
    F_COMWET.Show;
end;

procedure TF_COMTest.SysExitClick(Sender: TObject);
begin
   F_Pass.CallFunc:=1;
  F_Pass.show;
end;

procedure TF_COMTest.pwdchgClick(Sender: TObject);
begin
F_PASS.CallFunc:=0;
F_PASS.Show;
end;


procedure TF_COMTest.pwdregClick(Sender: TObject);
begin
  F_PASS.CallFunc:=3;
F_PASS.Show;
end;

procedure TF_COMTest.capClick(Sender: TObject);
begin
 F_PASS.CallFunc:=4;
F_PASS.Show;
end;

procedure TF_COMTest.N4Click(Sender: TObject);
begin
      F_PASS.Callfunc:=7;
      F_PASS.Show;
end;

procedure TF_COMTest.SearchClick(Sender: TObject);
begin
    F_PASS.Callfunc:=6;
F_PASS.Show;
end;





procedure TF_COMTest.ClTableClick(Sender: TObject);
begin
         F_PASS.Callfunc:=52;
F_PASS.Show;

end;

procedure TF_COMTest.CLTable2Click(Sender: TObject);
begin
  F_PASS.Callfunc:=53;
F_PASS.Show;

end;

procedure TF_COMTest.sysClick(Sender: TObject);
begin
            F_PASS.Callfunc:=51;
F_PASS.Show;

end;

procedure TF_COMTest.HdiesClick(Sender: TObject);
begin
 GroupBox1.Visible:=False;
end;

procedure TF_COMTest.systemClick(Sender: TObject);
begin
    F_PASS.Callfunc:=51;
F_PASS.Show;
end;

procedure TF_COMTest.N5Click(Sender: TObject);
begin
   SndPlaySound('Music',SND_ASYNC);    //声音播放
F_Gloat.Show;
end;

procedure TF_COMTest.RePrnClick(Sender: TObject);
begin
F_GloatRecord.Show;
end;

procedure TF_COMTest.N8Click(Sender: TObject);
begin
     F_PASS.Callfunc:=8;
     F_PASS.Show
end;
procedure  TF_COMTest.ShutDown;
begin
  WinExec('ShutDown.exe',0);           /////////////调用外部EXE文件;
end;

end.