receformm.pas

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

unit ReceFormM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls,GVAS,  Async32, ImgList, Buttons, RXCtrls,inifiles,
  Animate;//ImgList,

type
  TReceForm = class(TForm)
    CommSB: TStatusBar;
    PrgsImg: TImageList;
    Timer1: TTimer;
    Panel3: TPanel;
    Panel8: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Panel9: TPanel;
    amag2: TAnimatedImage;
    Button61: TBitBtn;
    MsgMo: TMemo;
    Panel4: TPanel;
    Panel6: TPanel;
    Label4: TLabel;
    Panel2: TPanel;
    savet: TLabel;
    PrgsBar1: TProgressBar;
    Panel1: TPanel;
    ReceBtn: TBitBtn;
    ExitBtn: TBitBtn;
    BitBtn10: TBitBtn;
    Panel5: TPanel;
    PrgsPB: TPaintBox;
    Button1: TBitBtn;
    Timer2: TTimer;
    Panel7: TPanel;
    Label3: TLabel;
    Image1: TImage;
    Image2: TImage;

    procedure FormShow(Sender: TObject);
    procedure ReceBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PrgsPBPaint(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BitBtn10Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button62Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
    FDataCount:integer;
    FDataPoint:integer;
    FDtryPoint:integer;
    FPenCode:byte;
    fe2buff:e2buff;
    FThrdCount:integer;
    FErrData:integer;
    revstart:boolean;
    FPenMode :string ;
    FComplateInfo :string ;
    procedure threaddone(SENDER:TOBJECT);
    procedure echomess(var  x1:tmessage); message WM_MESSAGE1;
    procedure echosavemess(var  x1:tmessage); message WM_MsgSave;
    procedure DrawOnePoint(x,Pclr:integer);
    procedure DrawCurrPoint(x:integer);
    procedure DrawTryPoint(x:integer);
    procedure DrawAllPoint;
    procedure process;
  public
    { Public declarations }
    sdatacount:integer;
    recetime:tdatetime ;//接收数据时间
  end;

var
  ReceForm: TReceForm;
  times:integer;

implementation
{$R *.DFM}
USES RECETHR, datamodal,menu, information;
procedure TReceForm.FormShow(Sender: TObject);
var
  ph,pw:integer;
  fh,fw:real;
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);
  label3.Font.Size:=9;
  label4.Font.Size:=9;
  savet.Font.Size:=9;
  MsgMo.Font.Size:=9;
  Button61.Font.Size:=9;
  Button1.Font.Size:=9;
  ReceBtn.Font.Size:=9;
  ExitBtn.Font.Size:=9;
  BitBtn10.Font.Size:=9;
  CommSB.Font.size:=9;
  end
  else
  begin
  self.Width:=600;
  self.Height :=380;
end;
label1.Caption:=inttostr(0);
label2.caption:=inttostr(0);
savet.Visible:=false;
prgsBar1.Visible:=false;
amag2.Active:=false;

{ scaled:=true;

  ph:=height-27;
  pw:=width-8;
  fh:=longint(screen.height)*96 / 600/screen.pixelsperinch;
  fw:=longint(screen.width)*96 / 800/screen.pixelsperinch;
  height:=round(ph*fh)+27;
  width :=round(pw*fw)+8;
  ScaleControls(screen.width, 800);
  ScaleControls(96,screen.pixelsperinch);
  CommSb.Canvas.font.size:=round(fw*8);

  progresspg.font.size:=round(fw*12);
  CommSB.Canvas.Brush.color:=clBtnFace;
  SaveT.Visible:=false;
  PrgsBar1.Visible:=false;
//  caption:=inttostr(height)+' x '+inttostr(width);
 }
end;

procedure TReceForm.ReceBtnClick(Sender: TObject);
var
  p1:pchar;
  comname,INIFile:string;
  wasconnect:boolean;

begin
  recetime:=now;
  fthrdcount:=0;
  fdatacount:=0;
  fdatapoint:=0;
  fdtrypoint:=0;
  drawallpoint;
  CommSB.panels[0].text:='';
  CommSB.panels[1].text:='';
  CommSB.panels[2].text:='';
  MsgMo.Lines.Clear;
  prgspb.Canvas.FillRect(ClientRect);
  SaveT.Visible:=false;
  PrgsBar1.Visible:=false;
  mainform.stopflag:=false;
  times:=0;
  try
    getmem(p1,16);
    comname:='';
    inifile:=ExtractFiledir(APPLICATION.EXENAME)+'\'+ExtractFilename(APPLICATION.EXENAME);//+'\hdxgxt.ini';
  if not fileexists(inifile) then
  inifile:=ExtractFileDir(APPLICATION.EXENAME)+'hdxgxt.ini'
  else inifile:=extractfiledir(application.exename)+'\hdxgxt.ini';
  if not fileexists(INIFile) then
    begin
      Application.MessageBox('需要設定串列通訊口！','消息',MB_ICONINFORMATION);
      exit;
    end  else
    begin
      getprivateprofilestring('comports','comportsnumber','01',p1,16,pchar(INIFile));
      comname:=p1;
      if strtoint(comname)<0 then
      begin
        Application.MessageBox('串口設置資訊丟失，請重新設置串列口！','消息',MB_ICONINFORMATION);
        exit;
      end;
      with TReadPenData.Create(self.handle,strtoint(comname)+1,Commsb,@Fe2buff)  do
      BEGIN //接触式
        Inc(FThrdCount);
        amag2.Active:=true;
        //image1.Visible:=true;
        image1.Visible:=true;
        timer2.Enabled:=true;
        OnTerminate := ThreadDone;
      END;

      RECEBtn.enabled:=FALSE;
      EXITBtn.Enabled:=FALSE;
      Button61.Enabled:=true;
      Button1.Enabled:=false;
     // button1.Enabled:=false;
    end;
  finally
    freemem(p1,16);
  end;

end;

procedure treceform.threaddone(SENDER:TOBJECT);

begin
//  Application.MessageBox('完成！','消息',MB_ICONINFORMATION);
  Dec(FThrdCount);
  if FThrdCount=0 then
  begin
    RECEBtn.enabled:=true;
    amag2.Active:=false;
    image2.Visible:=false;
    image1.Visible:=false;
    timer2.Enabled:=false;
    //EXITBtn.Enabled:=true;
   // button1.Enabled:=true;
   Button61.Enabled:=false;
   Button1.Enabled:=true;
   //prgspb.Canvas.FillRect(ClientRect);
  end;
end;
procedure TReceForm.ExitBtnClick(Sender: TObject);
//var child:tinformationform;
begin
//child:=tinformationform.Create(application);
//child.show;
informationform:=tinformationform.create(self);
informationform.showmodal;
informationform.free;
end;

procedure TReceForm.echomess(var  x1:tmessage);
var
//---------------------//
  filename:string;       //
  inifile1:Tinifile;     //
  path,temp,ss:string;      //
  //---------------------//
begin
  case ord(x1.WParam) of
    Msg_Comm:
      begin
        case ord(x1.lparam) of
          Msg_Comm_InitSuccess:MsgMo.Lines.Add('串口初始化成功') ;
          Msg_Comm_InitFale:Application.MessageBox('串口初始化出錯！','消息',MB_ICONINFORMATION);
          Msg_Comm_DeviceErr:
          begin
            if FPenMode ='0' then     //接触式
              Application.MessageBox('此次收取資料過程已經被中止，可能是通訊設備不正常或人爲中止，請檢查！','消息',MB_ICONINFORMATION)
            else
              Application.MessageBox('資料清除完畢！','消息',MB_ICONINFORMATION);
            MsgMo.Lines.Clear;
            prgspb.Canvas.FillRect(ClientRect);
          end;
          Msg_Comm_comerror:
          begin
          Application.MessageBox('通訊失敗！可能是您沒有正確地選擇串列口，請檢查！','消息',MB_ICONINFORMATION);
          MsgMo.Lines.Clear;
          prgspb.Canvas.FillRect(ClientRect);
          end;
        end;
      end;
    Msg_Pen:
      begin
        case ord(x1.lparam) of
          Msg_Pen_detecting:
          begin
          times:=times+1;
          if times<2 then
          //if revstart=false then
          MsgMo.Lines.Add('正在聯接巡更棒...');
          end;
          Msg_Pen_present:
          if revstart=false then
          begin
          MsgMo.lines.clear;
          MsgMo.Lines.Add('聯接到巡更棒');
          end;
          // Msg_Pen_absent:
          //if revstart=false then MsgMo.Lines.Add('聯接巡更棒失敗！','消息',MB_ICONINFORMATION);
          // Msg_Pen_Offline:
         // if revstart=false then MsgMo.Lines.Add('巡更棒通訊中斷！','消息',MB_ICONINFORMATION);
          Msg_Pen_DRStart:
          if revstart=false then
          begin
             MsgMo.Lines.Add('開始接收資料......');
             revstart:=true;
          end;
          Msg_Pen_DREnd:MsgMo.Lines.Add('接收資料結束.');
          Msg_Pen_ClearData:
          begin
          MsgMo.Lines.clear;
          MsgMo.Lines.Add('正在清除巡更棒中資料...');
          end;
          Msg_Pen_ClearDataSucc:
          begin           //MsgMo.Lines.Add('清除巡更棒中数据结束');
          Application.MessageBox('請等待大約30秒，清除完成後巡更棒將發出一聲鳴叫。','消息',MB_ICONINFORMATION);
          MsgMo.Lines.clear;
          end;
          //Msg_Pen_revdata:MsgMo.Lines.Add('读出一条记录.');
          Msg_Pen_SetTime:
          begin
          MsgMo.Lines.clear;
          MsgMo.Lines.Add('正在設置巡更棒中時間......');
          end;
          Msg_Pen_SetTimeSucc:
          begin
          MsgMo.Lines.clear;
   //       MsgMo.Lines.Add(FComplateInfo);
          MsgMo.Lines.Add('設置巡更棒中時間結束');
          end;
          Msg_Pen_GetTime:MsgMo.Lines.Add('正在讀取巡更棒中時間......');
          Msg_Pen_GetTimeSucc:MsgMo.Lines.Add('讀取巡更棒中時間結束');
          Msg_Pen_SaveData:
            if fdatacount>0 then
            begin
              //-------------------------------------------------------
                //getdir(0,path);
                //filename:=ExtractFileDir(APPLICATION.EXENAME)+'\hdxgxt.ini';
                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';

                //filename:=path+'\hdxgxt.ini';
                inifile1:=Tinifile.Create(filename);
                temp:=inifile1.ReadString('penmode','mode',ss);
                //showmessage(filename);
                inifile1.Free;
                ferrdata:=0;
                if temp='0' then
                with TSaveThr.Create(self.handle,fpencode,fdatacount,@Fe2buff)  do
                BEGIN
                Inc(FThrdCount);
                SaveT.Caption:='保存資料';
                SaveT.Visible:=true;
                PrgsBar1.Visible:=true;
                Button61.Enabled:=false;
                OnTerminate := ThreadDone;
                END
                else if temp='1' then
                with TSaveThr1.Create(self.handle,fpencode,fdatacount,@Fe2buff)  do
                BEGIN
                Inc(FThrdCount);
                SaveT.Caption:='保存資料';
                Button61.Enabled:=false;
                SaveT.Visible:=true;
                PrgsBar1.Visible:=true;
                OnTerminate := ThreadDone;
                END
                else
                begin
                    Application.MessageBox('未選擇巡更棒類型！','消息',MB_ICONINFORMATION);
                    //showmessage(temp);
                    exit;
                end;
//----------------------------------------------------------

            {  with TSaveThr.Create(self.handle,fpencode,fdatacount,@Fe2buff)  do
              BEGIN                  r
                Inc(FThrdCount);
                SaveT.Caption:='保存資料';
                SaveT.Visible:=true;
                PrgsBar1.Visible:=true;
                OnTerminate := ThreadDone;
              END;}
            end;
        end;
      end;
    Msg_PCode:
      begin
        MsgMo.Lines.Add('棒號：'+IntTohex(x1.lparam,2));
//        CommSB.Panels[0].Text:='棒號：'+IntTostr(x1.lparam);
        Fpencode:=byte(x1.lparam mod 256);
        CommSB.Panels[0].Text:='棒號：'+IntTohex(x1.lparam,2);
      end;
    Msg_PDataCount:
      begin
        MsgMo.Lines.Add('共有'+IntTostr(x1.lparam)+'組資料');
        CommSB.Panels[1].Text:=('共有'+IntTostr(x1.lparam)+'組資料');

        fdatapoint:=0;
        fdatacount:=x1.lparam;
        fdtrypoint:=0;
        DRAWALLPOINT;
      end;
    Msg_pDataPoint:
      begin
        CommSB.Panels[2].Text:='接收到'+IntToStr(x1.lparam)+'組資料';
   //     CommSB.Canvas.TextOut(206,4,'接收到'+IntToStr(x1.lparam)+'組資料');
        fdatapoint:=x1.lparam;
        drawCurrpoint(x1.lparam);
      end;
    Msg_PDtTryPoint:
      begin
        fdtrypoint:=x1.lparam;
        drawTrypoint(x1.lparam);
      end;
  else ;
  end;
end;

procedure TreceForm.DrawCurrPoint(x:integer);
var
  i1:integer;
begin
  if x=fdatacount then
  begin
    if (x mod 8)=0 then
      drawonepoint((x div 8),2)
    else
      drawonepoint((x div 8)+1,2);
  end