testpen.~pas

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

unit testpen;

interface

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

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;
    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);
  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
  if FThrdCount1>=1 then
  begin
     Application.MessageBox('正在通訊，請等待通訊完畢或中止該次通訊。','消息',MB_ICONINFORMATION);
     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;
      if comname1 ='' then
      begin
        Application.MessageBox(Pchar('需要設定串列通訊口'+#13#13+'運行[資料通信\設置巡更棒]'),'消息',MB_ICONINFORMATION);
        Exit ;
      end;
      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:Application.MessageBox('串口初始化出錯！','消息',MB_ICONINFORMATION);
          Msg_Comm_DeviceErr:
          begin
          Application.MessageBox('此次測試已經中止，可能是通訊設備不正常或人爲中止，請檢查！','消息',MB_ICONINFORMATION);
          MsgMo1.Lines.Clear;
          end;
          Msg_Comm_comerror:
          begin
          Application.MessageBox('通訊失敗，可能是您沒有正確地選擇串列口，請檢查！','消息',MB_ICONINFORMATION);
          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_settimeformatfale:
          begin
              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;
  end;

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

procedure TtestpenForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action :=caFree ;
  testpenForm :=nil ;
end;

procedure TtestpenForm.BitBtn3Click(Sender: TObject);
begin
if FThrdCount1>=1 then
  begin
     Application.MessageBox('正在通訊，請等待通訊完畢或終止該次通訊，才能退出視窗。','消息',MB_ICONINFORMATION);
     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
 Application.MessageBox('正在通訊，請等待通訊完畢或終止該次通訊，才能退出視窗。','消息',MB_ICONINFORMATION);
    canclose:=false;
  end;

end;

end.