📄 receformm.pas

📁 delphi6.0电子寻更源程序,用来计算保安有无查抄
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
  else
    if (x mod 8)=0 then
      drawonepoint((x div 8),2);
end;


procedure TReceForm.DrawTryPoint(x:integer);
begin
{  i1:=fdatacount div 8;
  if (fdatacount mod 8) <>0 then
    inc(i1);
  if
  if (fdatacount-x)<=8 then}
  if (x mod 8)=1 then
    drawonepoint((x div 8)+1,3);
end;

procedure TReceForm.DrawAllPoint;
var
  i1,i2,i3:integer;
begin
  IF FDATACOUNT=0 THEN EXIT;
  for i1:=1 to (fdatapoint div 8) do
  begin
    drawonepoint(i1,2);
  end;
  drawcurrpoint(fdatapoint);

  i2:=(fdatacount div 8);
  if (fdatacount mod 8)<>0 then inc(i2);
  i3:=fdatapoint div 8;
  if (fdatapoint mod 8)<>0 then inc(i3);

  for i1:=i3 to i2 do
  begin
    drawonepoint(i1,1);
  end;
end;

procedure TReceForm.DrawOnePoint(x,Pclr:integer);
var
  LedX,LedY,x1,y1:integer;
  Pen1,pen2:tpen;
  color1,color2,fco:Tcolor;
  a1,fx1,fy1:real;
begin
  ledx:=((x-1) mod (prgspb.Width div 10))*10;
  ledy:=((x-1) div (prgspb.Width div 10))*10;
  case ord(PClr)  of
      1:begin
          prgsimg.draw(prgspb.canvas,ledx,ledy,0);
        end;
      2:
        begin
          prgsimg.draw(prgspb.canvas,ledx,ledy,1);
        end;
      3:
        begin
          prgsimg.draw(prgspb.canvas,ledx,ledy,2);
        end;
  end;
end;

procedure TReceForm.FormCreate(Sender: TObject);
var
  filename:string;       //
  inifile1:Tinifile;     //
  path,ss:string;      //
begin
  fdatacount:=0;
  fdatapoint:=0;
  revstart:=false;
          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);
                FPenMode:=inifile1.ReadString('penmode','mode',ss);
                //showmessage(filename);
                inifile1.Free;
end;

procedure TReceForm.PrgsPBPaint(Sender: TObject);
begin
  DRAWALLPOINT;
end;

procedure TReceform.process;      //处理接收的数据  --无效
var
  linenumber,yearnum,num,l_lseq:integer;
  s,l_workname,l_dd,l_time,l_node,l_nodename,l_nodeplace,l_linename:string;

  spencode:string;
  v_year,v_month,v_day,v_hour,v_min,v_node1,v_node2,v_workcode:string;
begin
  try
    self.cursor:=crhourglass;
    spencode:=inttohex(FPenCode,2);
  datamodule1.q_PATROLREC.open;
  //datamodule1.q_WORKER.open;
  //datamodule1.q_POINT.IndexName:='';
  //datamodule1.q_POINT.IndexFieldNames:='node';
 // datamodule1.q_POINT.open;

//    frmpoint:=@receivedatabuffer;
    for linenumber:=1 to FDataCount do
    begin
      try
        V_year:='20'+inttohex(byte(FE2BUFF[Linenumber][1]),2);
        V_month:=inttohex(byte(FE2BUFF[Linenumber][2]),2);
        V_day:=inttohex(byte(FE2BUFF[Linenumber][3]),2);
        V_hour:=inttohex(byte(FE2BUFF[Linenumber][4]),2);
        V_min:=inttohex(byte(FE2BUFF[Linenumber][5]),2);
        V_node1:=inttohex(byte(FE2BUFF[Linenumber][6]),2);
        V_node2:=inttohex(byte(FE2BUFF[Linenumber][7]),2);
        v_workcode:=inttohex(byte(FE2BUFF[Linenumber][8]),2);

//        inc(frmpoint);
        l_dd:=v_year+'-'+v_month+'-'+v_day;
        l_time:=v_hour+':'+v_min;
        l_node:=v_node2+v_node1;

        {datamodule1.q_WORKER.First;
        datamodule1.q_WORKER.setkey;
        datamodule1.q_WORKER.fieldbyname('code').asstring:=v_workcode;
        if datamodule1.q_WORKER.gotokey then
          l_workname:=datamodule1.q_WORKER.fieldbyname('name').asstring
        else
          l_workname:='';


        datamodule1.q_POINT.first;
        datamodule1.q_POINT.setkey;
        datamodule1.q_POINT.fieldbyname('node').asstring:=l_node;
        if datamodule1.q_POINT.gotokey then
        begin
          l_nodename:=datamodule1.q_POINT.fieldbyname('name').asstring;
          l_nodeplace:=datamodule1.q_POINT.fieldbyname('nodeplace').asstring;
          l_linename:=datamodule1.q_POINT.fieldbyname('linename').asstring;
          l_lseq:=datamodule1.q_POINT.fieldbyname('lseq').asinteger;
        end  else  begin
          l_nodename:='';
          l_nodeplace:='';
          l_linename:='';
          l_lseq:=0;
        end;  }
        with  datamodule1.q_point do
       begin //0
       close;
       parambyname('node').asstring:=L_node;
       parambyname('code').asstring:=v_workcode;
       open;
       if recordcount=0 then
          begin    //0.0
          l_nodename:='';
          l_nodeplace:='';
          l_linename:='';
          l_lseq:=0;
          l_workname:='';
          datamodule1.q_PATROLREC.append;
          datamodule1.q_PATROLREC.fieldbyname('pdate').value:=strtodate(l_dd);
          datamodule1.q_PATROLREC.fieldbyname('ptime').asstring:=l_time;
          datamodule1.q_PATROLREC.fieldbyname('workercode').asstring:=V_workcode;
          datamodule1.q_PATROLREC.fieldbyname('node').asstring:=l_node;
          datamodule1.q_PATROLREC.fieldbyname('workername').asstring:=l_workname;
          datamodule1.q_PATROLREC.fieldbyname('nodename').asstring:=l_nodename;
          datamodule1.q_PATROLREC.fieldbyname('nodeplace').asstring:=l_nodeplace;
          datamodule1.q_PATROLREC.fieldbyname('linename').asstring:=l_linename;
          datamodule1.q_PATROLREC.fieldbyname('lseq').asinteger:=l_lseq;
          datamodule1.q_PATROLREC.fieldbyname('pencode').asstring:=spencode;
          datamodule1.q_PATROLREC.post;
          datamodule1.q_PATROLREC.refresh;
          end   //0.0/
          else
            begin //0.1
                while not eof do
               begin //0.2
               l_nodename:=fieldbyname('nodename').asstring;
               l_nodeplace:=fieldbyname('nodeplace').asstring;
               l_linename:=fieldbyname('linename').asstring;
               l_lseq:=fieldbyname('lseq').asinteger;
               l_workname:=fieldbyname('name').asstring;
               end;   //0.2
            end;//0.1
       end;   //0
        datamodule1.q_PATROLREC.append;
        datamodule1.q_PATROLREC.fieldbyname('pdate').value:=strtodate(l_dd);
        datamodule1.q_PATROLREC.fieldbyname('ptime').asstring:=l_time;
        datamodule1.q_PATROLREC.fieldbyname('workercode').asstring:=V_workcode;
        datamodule1.q_PATROLREC.fieldbyname('node').asstring:=l_node;
        datamodule1.q_PATROLREC.fieldbyname('workername').asstring:=l_workname;
        datamodule1.q_PATROLREC.fieldbyname('nodename').asstring:=l_nodename;
        datamodule1.q_PATROLREC.fieldbyname('nodeplace').asstring:=l_nodeplace;

        datamodule1.q_PATROLREC.fieldbyname('linename').asstring:=l_linename;
        datamodule1.q_PATROLREC.fieldbyname('lseq').asinteger:=l_lseq;

        datamodule1.q_PATROLREC.fieldbyname('pencode').asstring:=spencode;
        datamodule1.q_PATROLREC.post;
        datamodule1.q_PATROLREC.refresh;
      except
      end;
    end;
    Application.MessageBox('處理完畢！','消息',MB_ICONINFORMATION);
    Msgmo.lines.add('保存資料完畢！');
  finally
    datamodule1.q_PATROLREC.close;
   // datamodule1.T_WORKER.CLOSE;
   // datamodule1.T_POINT.close;
    self.Cursor:=crdefault;
  end;
end;

procedure TReceForm.echosavemess(var  x1:tmessage);
var
  p1:pchar;
  comname,INIFile:string;
  wasconnect:boolean;
 begin
  if X1.LPARAM=0 THEN INC(FERRDATA);
  PrgsBar1.Position:=(x1.WParam *100) div fdatacount;
  if x1.wparam =fdatacount  then
  begin
    if ferrdata>0  then  Application.MessageBox(pchar('資料保存完畢！'+
        chr($0d)+chr($0a)+'成功保存了'+ inttostr(fdatacount-ferrdata)+'個資料！'+
        chr($0d)+chr($0a)+'有'+ inttostr(ferrdata)+'個資料因時間格式錯誤未保存！'+#13+#13+'注意：當【接收消息】框出現：'+#13+'"設置巡更棒中時間結束"'+#13+#13+'後再單擊【確定】按鈕'),'消息',MB_ICONINFORMATION)
    else
    begin
      Application.MessageBox(pchar('資料保存完畢！'+#13+#13+'注意：當【接收消息】框出現：'+#13+'"設置巡更棒中時間結束"'+#13+#13+'後再單擊【確定】按鈕'),'消息',MB_ICONINFORMATION) ;
      ExitBtn.Enabled:=true;
    end;
     prgspb.Canvas.FillRect(ClientRect);
    if  ferrdata<>fdatacount then
    begin
     //if messagedlg('下次使用该巡更棒前，请务必清空数据！是否要清空巡更棒中的数据?'，mtinformation，[mbok,mbcancel],0)=mrcancel then
     //exit;
     //if messagedlg('确定吗？',mtConfirmation,[mbok,mbcancel],0)=mrcancel then
     //exit;
    fthrdcount:=0;
    fdatacount:=0;
    fdatapoint:=0;
    CommSB.panels[0].text:='';
    CommSB.panels[1].text:='';
    CommSB.panels[2].text:='';
    MsgMo.Lines.Clear;
    SaveT.Visible:=false;
    PrgsBar1.Visible:=false;
    try
      getmem(p1,16);
      comname:='';
      //INIFile:=ExtractFileDir(APPLICATION.EXENAME)+'\HdXGXT.INI';
      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 TClearPenData.Create(self.handle,strtoint(comname)+1,Commsb)  do
        BEGIN
          Inc(FThrdCount);
          OnTerminate := ThreadDone;
        END;
        RECEBtn.enabled:=FALSE;
        EXITBtn.Enabled:=FALSE;
       // button1.enabled:=false;
      end;
    finally
      freemem(p1,16);
    end;
  end;

  end;
  sdatacount:=fdatacount-ferrdata;
end;

procedure TReceForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if fthrdcount<> 0 then
  begin
 Application.MessageBox('正在通訊，請等待通訊完畢或終止該次通訊，才能退出視窗。','消息',MB_ICONINFORMATION);
    canclose:=false;
  end;
end;
 procedure TReceForm.BitBtn1Click(Sender: TObject);
begin
 close;

end;

procedure TReceForm.Button1Click(Sender: TObject);

var
  p1:pchar;
  comname,INIFile:string;
  wasconnect:boolean;
begin
  if Application.MessageBox('確定要清空巡更棒中的資料嗎?','消息', MB_ICONINFORMATION+MB_OKCANCEL) = IDCANCEL then
  exit;
  fthrdcount:=0;
  fdatacount:=0;
  fdatapoint:=0;
  CommSB.panels[0].text:='';
  CommSB.panels[1].text:='';
  CommSB.panels[2].text:='';
  MsgMo.Lines.Clear;
  SaveT.Visible:=false;
  PrgsBar1.Visible:=false;
  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 TClearPenData.Create(self.handle,strtoint(comname)+1,Commsb)  do
      BEGIN
        Inc(FThrdCount);
        OnTerminate := ThreadDone;
      END;
      RECEBtn.enabled:=FALSE;
      EXITBtn.Enabled:=FALSE;
     // button1.enabled:=false;
    end;
  finally
    freemem(p1,16);
  end;

end;


procedure TReceForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action:=cafree;
// informationForm.Free;
// informationForm:=nil;
end;

procedure TReceForm.BitBtn10Click(Sender: TObject);
begin
close;
end;

procedure TReceForm.Timer1Timer(Sender: TObject);
begin
if (label1.caption<>'0')and(label2.caption<>'0') then
ExitBtn.Enabled:=true
else
exitbtn.Enabled:=false;
end;

procedure TReceForm.Button62Click(Sender: TObject);
begin
    mainform.stopflag:=true;
end;

procedure TReceForm.Button2Click(Sender: TObject);
begin
{with  do
begin
//Canvas.MoveTo(0, 0);


//copymode:=cmwhiteness;
//arect:=rect(0,0,prgspb.Width,prgspb.Height);
//copyrect(arect,prgspb.canvas,rect);
//copymode:=cmsrccopy;
end; }
end;
procedure TReceForm.Timer2Timer(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;

end.
//proc
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -