📄 settest.~pas

📁 delphi6.0电子寻更源程序,用来计算保安有无查抄
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
      begin
         Application.MessageBox('系統文件丟失，請再次選擇串口！','消息',MB_ICONINFORMATION);
         exit;
      end;
      //code1:=bytedectohex(strtoint(pencode_edit.Text));
       //showmessage(inttostr(int1));
       code1:=int1;//code1:=bytedectohex(int1);
      with TWritePenCODE.Create(self.handle,strtoint(comname)+1,StatusBar1,code1)  do
      BEGIN
        amag.Active:=true;
        inc(FThrdCount);
        OnTerminate := ThreadDone;
      END;
      Button6.enabled:=true;
      image1.Visible:=true;
      timer1.Enabled:=true;
      {button1.Enabled:=false;
      button2.Enabled:=false;
      button3.Enabled:=false;
      button4.Enabled:=false;}


  end;

procedure Tsettestform.echomess(var  x1:tmessage);
BEGIN
    case ord(x1.WParam) of
    Msg_Comm:
      begin
        case ord(x1.lparam) of
          Msg_Comm_InitSuccess:
          begin
          MsgMo.lines.add('串口初始化成功');
          end;
          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;
          end;
          Msg_Comm_comerror:
          begin
          Application.MessageBox('通訊失敗！可能是您沒有正確地選擇串列口，請檢查！','消息',MB_ICONINFORMATION);
          MsgMo.lines.Clear;
         end;
        end;
      end;
    Msg_Pen:
      begin
        case ord(x1.lparam) of
          Msg_Pen_detecting:
          begin
          iiii:=iiii+1;
          if iiii<2 then
          MsgMo.lines.add('正在聯接巡更棒,請等待...');
          end;
          Msg_Pen_present:
          begin
          msgmo.Lines.Clear;
          MsgMo.lines.add('聯接到巡更棒');
          end;
          Msg_Pen_absent:
          begin
          //MsgMo.lines.add('联接巡更棒失败!');
          end;
          Msg_Pen_WritePencode:MsgMo.lines.add('正在設置棒號');
          Msg_Pen_WritePencodeSucc:
          begin
          MsgMo.lines.Add('設置棒號正確！');
          //pencode_Edit.Text:=inttostr(strtoint(pencode_edit.text)+1);
          end;
          Msg_Pen_WritePencodefale:MsgMo.lines.Add('設置棒號錯誤!');
          Msg_Pen_WritePenMode:MsgMo.lines.add('正在設置模式...');
          Msg_Pen_WritePenModeSucc:MsgMo.lines.add('設置模式正確！');
          Msg_Pen_WritePenModefale:MsgMo.lines.add('設置模式錯誤！');
          Msg_Pen_setpenmod:MsgMo.lines.add('正在設置工作方式...');
          Msg_Pen_setpenmodSucc:MsgMo.lines.add('設置工作方式成功！');
          Msg_Pen_setpenmodfale:MsgMo.lines.add('設置工作方式失敗！');
          Msg_Pen_SetTime:MsgMo.lines.add('正在設置時間...');
          Msg_Pen_SetTimeSucc:MsgMo.lines.add('設置時間正確！');
          Msg_Pen_SetTimefale:MsgMo.lines.add('設置時間錯誤！');
        end;
      end;
   end;
end;

procedure Tsettestform.threaddone(Sender:Tobject);
begin
    amag.Active:=false;
    dec(FThrdCount);
    imgenable:=false;
    Button6.enabled:=false;
    image1.Visible:=false;
    image2.Visible:=false;
    timer1.Enabled:=false;
   // button1.Enabled:=true;
   //   button2.Enabled:=true;
   //   button3.Enabled:=true;
   //   button4.Enabled:=true;
     // button5.Enabled:=true;
     // test_button.Enabled:=true;
end;

procedure Tsettestform.set_TimerTimer(Sender: TObject);

var
   y,m,d,hour,min,sec,msec:word;
   year:string;

begin

   set_Timer.Interval:=1000;

   decodedate(date,y,m,d);
   decodetime(time, hour,min,sec,msec);
   year:=int2str(Y,4);
  // delete(year,1,2);

  date_Edit.text:=year+'-'+int2str(m,2)+'-'+int2str(d,2)+' '+int2str(hour,2)+':'+int2str(min,2)+':'+int2str(sec,2);
  //time_Edit.text:=
  //imagelist1.Draw(image1.canvas,0,0,
end;

function tsettestform.int2str(n:longint;len:integer):string;
begin
    fmtstr(result,'%d',[n]);
    while length(result)<len do
    result:='0'+result;
end;


procedure Tsettestform.Button2Click(Sender: TObject);
var
  mode1:byte;
  comname:string;
begin
  if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊，請等待通訊完畢或中止該次通訊。','消息',MB_ICONINFORMATION);
     EXIT;
  END;
iiii:=0;
  MsgMo.Lines.Clear;
mainform.stopflag:=false;
  comname:=readcomname;
      if comname='' then
      begin
         Application.MessageBox('系統文件丟失,請再次選擇串口！','消息',MB_ICONINFORMATION);
         exit;
      end;
      if Key_RadioB.checked then mode1:=1
      else mode1:=2;
      try
        with TSetPenMode.Create(self.handle,strtoint(comname)+1,StatusBar1,mode1)  do
        BEGIN
          amag.Active:=true;
          inc(FThrdCount);
          OnTerminate := ThreadDone;
        END;
        Button6.enabled:=true;
         image1.Visible:=true;
      timer1.Enabled:=true;
        {button1.Enabled:=false;
        button2.Enabled:=false;
        button3.Enabled:=false;
        button4.Enabled:=false;}

      except
        Application.MessageBox('無法設置！','消息',MB_ICONINFORMATION);
      end;

end;

procedure Tsettestform.Button4Click(Sender: TObject);
var
  comname:string;
  chmodel:boolean;
begin
  if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊，請等待通訊完畢或中止該次通訊。','消息',MB_ICONINFORMATION);

     EXIT;
  END;
iiii:=0;
  MsgMo.Lines.Clear;
mainform.stopflag:=false;
  if  buzz_RadioB.Checked=true then
  chmodel:=true
  else
  chmodel:=false;
      comname:=readcomname;
      if comname='' then
      begin
         Application.MessageBox('串口資訊丟失，請再次設置串口！','消息',MB_ICONINFORMATION);
         exit;
      end;
      with Tsetpenmod.Create(self.handle,strtoint(comname)+1,StatusBar1,chmodel)  do
      BEGIN
        amag.Active:=true;
        inc(FThrdCount);
        OnTerminate := ThreadDone;
      END;
      Button6.enabled:=true;
       image1.Visible:=true;
      timer1.Enabled:=true;
      {button1.Enabled:=false;
      button2.Enabled:=false;
      button3.Enabled:=false;
      button4.Enabled:=false;}

end;

procedure Tsettestform.Button3Click(Sender: TObject);
var
  comname:string;
  wasconnect:boolean;
  testb:byte;
  DATE1,TIME1:TDATETIME;
begin
      if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊，請等待通訊完畢或中止該次通訊。','消息',MB_ICONINFORMATION);
     EXIT;
  END;
iiii:=0;
      MsgMo.lines.Clear;
mainform.stopflag:=false;
      comname:=readcomname;
      if comname='' then
      begin
         Application.MessageBox('串口資訊丟失，請再次設置串口！','消息',MB_ICONINFORMATION);
         exit;
      end;
      testb:=0;
      try
        DATE1:=date;
        TIME1:=time;
        with TWritePenClock.Create(self.handle,strtoint(comname)+1,StatusBar1,DATE1,TIME1)  do
        BEGIN
          amag.Active:=true;
          inc(FThrdCount);
          OnTerminate := ThreadDone;
        END;
        Button6.enabled:=true;
         image1.Visible:=true;
      timer1.Enabled:=true;
        {button1.Enabled:=false;
        button2.Enabled:=false;
        button3.Enabled:=false;
        button4.Enabled:=false;}
      except
        Application.MessageBox('非法時間格式！','消息',MB_ICONINFORMATION);
      end;
   
end;

procedure Tsettestform.Button6Click(Sender: TObject);
begin
   mainform.stopflag:=true;
end;

procedure Tsettestform.Button5Click(Sender: TObject);
begin
  if setkeyset(left_edit.text,mid_edit.text,right_edit.text)=1 then
  Application.MessageBox('狀態鍵設置成功！','消息',MB_ICONINFORMATION)
  else
  Application.MessageBox('狀態鍵設置失敗！','消息',MB_ICONINFORMATION);
end;
procedure Tsettestform.Button7Click(Sender: TObject);
var ii:integer;
begin
//ii:=read_reccount;
//Application.MessageBox('width='+inttostr(self.width)+'--'+'height='+inttostr(self.height)+'--'+'left='+inttostr(self.left)+'--top='+inttostr(self.top));
end;

procedure Tsettestform.BitBtn1Click(Sender: TObject);
begin
  if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊中，請等待通訊完畢或中止該次通訊才能退出表單。','消息',MB_ICONINFORMATION);
     EXIT;
  END;
close;
end;

procedure Tsettestform.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 Tsettestform.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
 if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊中，請等待通訊完畢或中止該次通訊才能退出表單。','消息',MB_ICONINFORMATION);
     canclose:=false;
     EXIT;
  END;
end;

procedure Tsettestform.com_baudChange(Sender: TObject);
var
   temp,filename,path: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:=inttostr(com_baud.ItemIndex);
   inifile.WriteString('com_baud','type',temp);
   inifile.Free;
   COMBAUD:=COM_BAUD.ItemIndex;}
end;
procedure Tsettestform.FormActivate(Sender: TObject);
var
   temp,filename,path: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:=inttostr(com_baud.ItemIndex);
   temp:=inifile.readstring('com_baud','type',temp);
   if temp='' then
      inifile.WriteString('com_baud','type',inttostr(combaud));
   if combaud=0 then
      com_baud.Text:='2400';
   if combaud=1 then
      com_baud.Text:='19200';
   //com_baud.ItemIndex:=combaud;
   inifile.Free;
end;
end.
上一页 12
⌨️ 快捷键说明

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