📄 settest.~pas

📁 delphi6.0电子寻更源程序,用来计算保安有无查抄
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit settest;

interface

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


type
  Tsettestform = class(TForm)
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    com_ComboB: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    GroupBox3: TGroupBox;
    key_RadioB: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox4: TGroupBox;
    date_Edit: TEdit;
    GroupBox5: TGroupBox;
    buzz_RadioB: TRadioButton;
    RadioB: TRadioButton;
    set_Timer: TTimer;
    MsgMo: TMemo;
    StatusBar1: TStatusBar;
    GroupBox6: TGroupBox;
    amag: TAnimatedImage;
    hide1: TLabel;
    Label5: TLabel;
    Button1: TBitBtn;
    GroupBox7: TGroupBox;
    Label4: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    left_Edit: TEdit;
    mid_Edit: TEdit;
    right_Edit: TEdit;
    Button5: TBitBtn;
    Button2: TBitBtn;
    Button3: TBitBtn;
    Button4: TBitBtn;
    Button6: TBitBtn;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    Image1: TImage;
    Image2: TImage;
    pencode_Edit: TEdit;
    com_baud: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure com_ComboBChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure set_TimerTimer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure com_baudChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FThrdCount:integer;
    imgenable:boolean;
    FPenMode :string ;
    function readcomname:string;
    procedure echomess(var  x1:tmessage); message WM_MESSAGE1;
    procedure threaddone(Sender:TObject);
    function  int2str(n:longint;len:integer):string;
    function  hextoint(i:string):integer;
  public
    { Public declarations }
    stopflag:boolean;
  end;

var
  settestform: Tsettestform;
  iiii:integer;
implementation

uses menu;

{$R *.DFM}
function tsettestform.hextoint(i:string):integer;
begin
if i='1' then
result:=1;
if i='2' then
result:=2;
if i='3' then
result:=3;
if i='4' then
result:=4 ;
if i='5' then
result:=5;
if i='6' then
result:=6;
if i='7' then
result:=7;
if i='8' then
result:=8 ;
if i='9' then
result:=9;
if i='A' then
result:=10 ;
if i='B' then
result:=11;
if i='C' then
result:=12  ;
if i='D' then
result:=13;
if i='E' then
result:=14   ;
if i='F' then
result:=15;
if i='0' then
result:=0;
end;
procedure Tsettestform.FormCreate(Sender: TObject);
var
  path,filename,temp,_mode,s2:string;
  inifile:tinifile;
  ls,ms,rs:string;
begin
  FThrdCount:=0;
  imgenable:=false;
  pencode_Edit.text:='1';
  stopflag:=false;
  s2:=readcomname;
  IF	s2='0' THEN com_ComboB.ItemIndex:=0
  ELSE
  IF	s2='1' THEN com_ComboB.ItemIndex:=1
  ELSE
  IF	s2='2' THEN com_ComboB.ItemIndex:=2
  ELSE
  IF	s2='3' THEN com_ComboB.ItemIndex:=3
  ELSE	com_ComboB.ItemIndex:=0;
  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);
  _mode:=inifile.ReadString('penmode','mode',temp);
  inifile.free;
  FPenMode :=_mode ;
  if _mode='0' then
  begin
     key_RadioB.Enabled:=false;
     RadioButton2.Enabled:=false;
     Button2.Enabled:=false;
     left_edit.Enabled:=false;
     mid_edit.enabled:=false;
     right_edit.enabled:=false;
     button5.Enabled:=false;
     GroupBox7.Enabled:=FALSE;
     GroupBox3.Enabled :=FALSE;
  end;

  getkeyset(ls,ms,rs);//edit_left.text,edit_middle.text,edit_right.text);
  left_edit.text:=ls;
  mid_edit.text:=ms;
  right_edit.text:=rs;
end;

function Tsettestform.readcomname: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 Tsettestform.FormShow(Sender: TObject);
var
  s2:string;
  i1,i2,i3:integer;
  f1,f2:real;
begin
if (screen.Height<600) and( screen.Width<800) then
  begin
  scaled:=true;
  height:=round(323*longint(screen.height)*96 / 600/screen.pixelsperinch);
  width :=round( 745 *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);
  label1.Font.Size:=10;
  label2.Font.Size:=10;
  label3.Font.Size:=10;
  label4.Font.Size:=10;
  label5.Font.Size:=10;
  label6.Font.Size:=10;
  label7.Font.Size:=10;
  com_ComboB.Font.Size:=10;
  Button1.font.size:=10;
  //Edit1.Font.Size:=10;
  pencode_Edit.Font.Size:=10;
  left_Edit.Font.Size:=10;
  mid_Edit.Font.Size:=10;
  right_Edit.Font.Size:=10;
  Button5.Font.Size:=10;
  key_RadioB.Font.Size:=10;
  RadioButton2.Font.Size:=10;
  Button2.Font.Size:=10;
  date_Edit.Font.Size:=10;
  Button3.Font.Size:=10;
  buzz_RadioB.Font.Size:=10;
  RadioB.Font.Size:=10;
  Button4.Font.Size:=10;
  MsgMo.Font.Size:=10;
  Button6.Font.Size:=10;
  GroupBox1.Font.Size:=10;
  GroupBox2.Font.Size:=10;
  GroupBox3.Font.Size:=10;
  GroupBox4.Font.Size:=10;
  GroupBox5.Font.Size:=10;
  GroupBox6.Font.Size:=10;
  GroupBox7.Font.Size:=10;
  StatusBar1.Font.Size:=10;
  BitBtn1.Font.Size:=10;
  end
  else
  begin
   self.Height:=323;
  self.Width:=745;
  end;
  FThrdCount:=0;
  s2:=readcomname;
  MsgMo.Lines.Clear;
  IF	s2='0' THEN com_ComboB.ItemIndex:=0
  ELSE
  IF	s2='1' THEN com_ComboB.ItemIndex:=1
  ELSE
  IF	s2='2' THEN com_ComboB.ItemIndex:=2
  ELSE
  IF	s2='3' THEN com_ComboB.ItemIndex:=3
  ELSE	com_ComboB.ItemIndex:=0;
  amag.Active:=false;
end;

procedure Tsettestform.com_ComboBChange(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_ComboB.ItemIndex);
   inifile.WriteString('comports','comportsnumber',temp);
   inifile.Free;
end;

procedure Tsettestform.Button1Click(Sender: TObject);
var
  code1:byte;
  comname:string;
  ch,s1,s2:string;
  len:integer;
  i:integer;
  int1:integer;
begin
int1:=0;
  if FThrdCount>=1 then
  begin
     Application.MessageBox('正在通訊！請等待通訊完畢或中止該次通訊。','消息',MB_ICONINFORMATION);
     EXIT;
  END;
  iiii:=0;
  MsgMo.Lines.Clear;
  mainform.stopflag:=false;
  if pencode_edit.Text='' then
  begin
     Application.MessageBox('請輸入2位棒號！','消息',MB_ICONINFORMATION);
     pencode_edit.SetFocus;
     exit;
  end
  else
  begin
  try
  ch:=uppercase(trim(pencode_edit.Text));
  if (length(trim(ch)))>2 then
   begin
   Application.MessageBox('請輸入2位棒號，範圍在00-FF之間！','消息',MB_ICONINFORMATION);
   pencode_edit.SetFocus ;
   pencode_edit.Text :='';
   exit;
   end;
   if  (length(trim(ch)))=1 then
   begin            //1位
   s1:=uppercase(copy(ch,1,1));
   if (uppercase(s1)<'0')or(uppercase(s1)>'F') then
   begin
   Application.MessageBox('請輸入2位棒號，範圍在00-FF之間！','消息',MB_ICONINFORMATION);
   pencode_edit.SetFocus ;
   pencode_edit.Text :='';
   exit;
   end;
   pencode_edit.Text:='0'+ch;
   end //1 位
   else
   begin //2 位
   s1:=uppercase(copy(ch,1,1));
   s2:=uppercase(copy(ch,2,1));
   if (((uppercase(s1)<'0')or(uppercase(s1)>'F'))or((uppercase(s2)<'0')or(uppercase(s2)>'F'))) then
   begin
   Application.MessageBox('請輸入2位棒號，範圍在00-FF之間！','消息',MB_ICONINFORMATION);
   pencode_edit.SetFocus ;
   pencode_edit.Text :='';
   exit;
   end;
   end; len:=length(pencode_edit.text);
  for i:=1 to len do
  begin
  IF I=1 THEN
  BEGIN
  int1:=int1+16*hextoint(uppercase(pencode_edit.Text[1]));
  END;
  if i=2 then
  begin
  int1:=int1+hextoint(uppercase(pencode_edit.Text[2]))
  end;
  end;
  //showmessage(inttostr(int1));
  except
  begin
   Application.MessageBox('請輸入2位棒號，範圍在00-99之間！','消息',MB_ICONINFORMATION);
   pencode_edit.SetFocus ;
   pencode_edit.Text :='';
   exit;
   end;
  end;
 end;

      comname:=readcomname;
      if comname='' then
12 下一页
⌨️ 快捷键说明

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