testpen1.pas

delphi6.0电子寻更源程序,用来计算保安有无查抄

unit testpen;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Animate, ExtCtrls, ComCtrls,Gvas,Recethr,inifiles, Buttons,
  OleCtrls, MSCommLib_TLB;

type
  TtestpenForm = class(TForm)
    Panel1: TPanel;
    StatusBar2: TStatusBar;
    GroupBox1: TGroupBox;
    TestDataCB: TCheckBox;
    TimeCB: TCheckBox;
    LedCB: TCheckBox;
    BellCB: TCheckBox;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Label1: TLabel;
    MsgMo1: TMemo;
    GroupBox6: TGroupBox;
    amag1: TAnimatedImage;
    Button61: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Timer1: TTimer;
    Image1: TImage;
    Image2: TImage;
    MSComm1: TMSComm;
    Timer2: TTimer;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button61Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
     FThrdCount1:integer;
    comname1:string;
    datepointer:strpointer;
    function readcomname1:string;
    procedure echomess(var x1:tmessage); message WM_MESSAGE1;
    procedure threaddone(sender:tobject);
    
  public
    { Public declarations }
    //stopflag1:boolean;
  end;

var
  testpenForm: TtestpenForm;
  times:integer;

implementation
uses menu;
{$R *.DFM}

procedure TtestpenForm.Button1Click(Sender: TObject);
begin
    testdatacb.Checked:=true;
    timecb.Checked:=true;
    ledcb.Checked:=true;
    bellcb.Checked:=true;
end;

procedure TtestpenForm.Button2Click(Sender: TObject);
var
  wasconnect:boolean;
  testb:byte;
begin
MSCOMM1.PortOpen:=true;
timer2.Enabled:=true;
  if FThrdCount1>=1 then
  begin
     showmessage('正在通讯，请等待通讯完毕或中止该次通讯。');
     times:=3;
     EXIT;
  END;
  times:=0;
  MsgMo1.Lines.Clear;
  //stopflag:=false;
      mainform.stopflag:=false;
      testb:=0;
      if  timeCB.Checked then testb:=testb or byte(test_time);
      if  ledCB.Checked then testb:=testb or byte(test_led);
      if  bellCB.Checked then testb:=testb or byte(test_bell);
      if  TestdataCB.Checked then testb:=testb or byte(test_datacnt);
      comname1:=readcomname1;
      new(datepointer);
      with TTestPen.Create(self.handle,strtoint(comname1)+1,StatusBar2,testb,datepointer)  do
      BEGIN
        amag1.Active:=true;
        inc(FThrdCount1);
        OnTerminate := ThreadDone;
      END;
      Button61.Enabled:=true;
      image1.Visible:=true;
      timer1.Enabled:=true; //闪动
      BItBtn1.Enabled:=false;
      BItBtn2.Enabled:=false;
      if  TestDataCB.Checked then
       TestDataCB.Enabled:=false;
      if  TimeCB.Checked then
       TimeCB.Enabled:=false;
      if LedCB.Checked then
      LedCB.Enabled:=false;
      if BellCB.Checked then
      BellCB.Enabled:=false;
end;

function ttestpenform.readcomname1:string;
var
   path,filename,temp:string;
   inifile:tinifile;
begin
  filename:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
   if not fileexists(filename) then
   filename:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
   else filename:=extractfiledir(application.exename)+'\hdxgxt.ini';
   inifile:=Tinifile.create(filename);
   temp:=inifile.ReadString('comports','comportsnumber',temp);
   result:=temp;
   inifile.Free;
end;
procedure TtestpenForm.FormCreate(Sender: TObject);
begin
  FThrdCount1:=0;
  //stopflag:=false;
end;

procedure TTESTPENFORM.echomess(var  x1:tmessage);
BEGIN
    case ord(x1.WParam) of
    Msg_Comm:
      begin
        case ord(x1.lparam) of
          Msg_Comm_InitSuccess:MsgMo1.lines.add('串口初始化成功');
          Msg_Comm_InitFale:ShowMessage('串口初始化出错！');
          Msg_Comm_DeviceErr:
          begin
          showmessage('此次测试已经中止，可能是通讯设备不正常或人为中止，请检查！');
          MsgMo1.Lines.Clear;
          end;
          Msg_Comm_comerror:
          begin
          showmessage('通讯失败，可能是您没有正确地选择串行口，请检查！');
          MsgMo1.Lines.Clear;
          end;
        end;
      end;
    Msg_Pen:
      begin
        case ord(x1.lparam) of
         Msg_Pen_detecting:
         begin
         times:=times+1;
         if times<2 then
         MsgMo1.Lines.Add('正在试图联接巡检棒,请等待...');
         end;
          Msg_Pen_present:
          begin
          //msgmo1.Lines.Clear;
          MsgMo1.Lines.Add('联接到巡检棒');
          end;
          //Msg_Pen_absent://MsgMo.Lines.Add('联接巡检棒失败!');
          Msg_Pen_Offline:MsgMo1.Lines.Add('巡检棒通讯中断!');
          Msg_Pen_SetTime:MsgMo1.Lines.Add('正在设置巡检棒中时间......');
          Msg_Pen_SetTimeSucc:
          begin
              MsgMo1.Lines.Add('巡检棒时间和本机时间一至');
              MsgMo1.Lines.Add(datepointer^);
          end;
          Msg_Pen_SetTimeFale:
          begin
              MsgMo1.Lines.Add('巡检棒时间和本机时间相差大');
              MsgMo1.Lines.Add(datepointer^);
          end;
          Msg_Pen_GetTime:MsgMo1.Lines.Add('正在读取巡检棒中时间......');
          Msg_Pen_GetTimeSucc:MsgMo1.Lines.Add('读取巡检棒中时间结束');
          Msg_Pen_TestLed:MsgMo1.Lines.Add('检测巡检棒灯');
          Msg_Pen_TestBell:MsgMo1.Lines.Add('检测巡检棒蜂鸣器');
          Msg_Pen_ReadTime:MsgMo1.Lines.Add('读取巡检棒时钟');
          Msg_Pen_DatacntERR:MsgMo1.Lines.Add('错误的数据目录');
          Msg_Pen_Testdatacnt:MsgMo1.Lines.Add('检查数据目录');
        end;
      end;
    Msg_PCode:
      begin
        MsgMo1.Lines.Add('棒号：'+IntToHex(x1.lparam,2));
        //CommSB.Panels[0].Text:='棒号：'+IntTohex(x1.lparam,2);
      end;
    Msg_PDataCount:
      begin
        MsgMo1.Lines.Add('共有'+IntTostr(x1.lparam)+'组数据');
        //CommSB.Panels[1].Text:=('共有'+IntTostr(x1.lparam)+'组数据');
      end;
    Msg_pDataPoint:
      begin
        //CommSB.Canvas.TextOut(206,4,'接收到'+IntToStr(x1.lparam)+'组数据');
      end;
    Msg_PDtTryPoint:
      begin
      end;
  else ;
  end;
END;

procedure ttestpenform.threaddone(sender:tobject);
begin
   amag1.Active:=false;
    dec(FThrdCount1);
    Button61.Enabled:=false;
     timer1.Enabled:=false;
     image1.Visible:=false;
     image2.Visible:=false;
    Bitbtn2.Enabled:=true;
    Bitbtn1.Enabled:=true;
    TestDataCB.Enabled:=true;
    TimeCB.Enabled:=true;
    LedCB.Enabled:=true;
    BellCB.Enabled:=true;
end;

procedure TtestpenForm.Button61Click(Sender: TObject);
begin
   mainform.stopflag:=true;
end;

procedure TtestpenForm.FormShow(Sender: TObject);
begin
if (screen.Height<600) and( screen.Width<800) then
  begin
  scaled:=true;
  height:=round(height*longint(screen.height)*96 / 600/screen.pixelsperinch);
  width :=round( width *longint(screen.width)*96 / 800/screen.pixelsperinch);
  left:=round((screen.Width-Width)/2);
  top:=round((screen.height-self.height)/2);
  ScaleControls(screen.width, 800);
  ScaleControls(96,screen.pixelsperinch);
  TestDataCB.Font.Size:=9;
  TimeCB.Font.Size:=9;
  LedCB.Font.Size:=9;
  BellCB.Font.Size:=9;
  GroupBox1.Font.Size:=9;
  BitBtn2.Font.Size:=9;
  Label1.Font.Size:=9;
  MsgMo1.Font.Size:=9;
  GroupBox6.font.size:=9;
  Button61.Font.Size:=9;
  BitBtn1.Font.Size:=9;
  Panel2.Font.Size:=9;
  StatusBar2.Font.Size:=9;
  BitBtn3.Font.Size:=9;
  end
  else
  begin
   self.Height:=379;
  self.Width:=410;
  self.Top:=mainform.Height-mainform.clientheight+mainform.ToolBar2.Height+round((mainform.ClientHeight-mainform.ToolBar2.Height-mainform.StatusBar.Height-self.Height)/2);
  self.Left:=round((mainform.Width-self.Width)/2);
  end;

   FThrdCount1:=0;
   amag1.Active:=false;
   MsgMo1.Lines.clear;
end;

procedure TtestpenForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
mainform.N_testpen.Enabled:=true;
mainform.ToolButton38.Enabled:=true;

end;

procedure TtestpenForm.BitBtn3Click(Sender: TObject);
begin
if FThrdCount1>=1 then
  begin
     showmessage('正在通讯，请等待通讯完毕或中止该次通讯,才能退出窗口。');
     times:=3;
     EXIT;
  END;
close;
end;

procedure TtestpenForm.Timer1Timer(Sender: TObject);
begin
if image1.Visible=true then
begin
image2.Visible:=true;
image1.Visible:=false;
exit;
end
else
begin
image1.Visible:=true;
image2.Visible:=false;
exit;
end;

end;

procedure TtestpenForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
if FThrdCount1>=1 then
  begin
 showmessage('正在通讯，请等待通讯完毕或中止该次通讯,才能退出窗口。');
    canclose:=false;
  end;

end;

procedure TtestpenForm.Timer2Timer(Sender: TObject);
begin
memo1.Lines.Add(mscomm1.Input);
end;

end.