📄 unit1.pas
字号:
vTmp:=vararraycreate([0,ren],varbyte);
vTmp:=ovTmp;
if checkbox1.State=cbChecked then for i:=0 to ren-1 do begin
bTmp:=vTmp[i];
memo3.Text:=memo3.Text+byteto2xstr(bTmp)+' ';;
end;
end;
end;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
if com2open then exit;
MSComm2.InBufferCount:=0;
MSComm2.InputLen:=0;
MSComm2.RThreshold:=1; //每次接到字符就产生onComm事件
MSComm2.Settings:=edit2.Text;
MSComm2.CommPort:=strtoint(edit3.Text);
MSComm2.InputMode:=ComInputModeBinary;
try
MSComm2.PortOpen:=true;
except
on E:Exception do begin
MessageDlg('串口打不开，请关闭其它应用程序.', mtInformation,[mbOk], 0);
MSComm2.PortOpen:=false;
exit;
end;
end;
if ComboBox1.Text='ON高电平' then MSComm2.DTREnable:=TRUE
else MSComm2.DTREnable:=false;
if ComboBox2.Text='ON高电平' then MSComm2.RTSEnable:=TRUE
else MSComm2.RTSEnable:=false;
com2open:=TRUE;
button9.Enabled:=false;
button10.Enabled:=true;
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
if com2open then begin
MSComm2.PortOpen:=false;
end;
MSComm2.DTREnable:=false;
MSComm2.RTSEnable:=false;
com2open:=false;
button9.Enabled:=true;
button10.Enabled:=false;
end;
procedure TForm1.Button11Click(Sender: TObject);
begin
fullsend:=true;
Button4_11Click(Sender);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
s:string;
bTmp:byte;
c1,c2:char;
begin
if checkBox2.State<>cbChecked then exit;
if displen>=bfrelen then exit ;
for i:=displen to bfrelen-1 do begin
s:='00 ';
bTmp:=bytebf[i];
asm
mov ax,0
mov al, bTmp
push ax
shr al,4
cmp al,10
jge @@aaa1
add al,'0'
jmp @@end1
@@aaa1:add al,'A'-10
@@end1:mov c1,al
pop ax
and al,0fh
cmp al,10
jge @@aaa2
add al,'0'
jmp @@end2
@@aaa2:add al,'A'-10
@@end2:mov c2,al
end;
s[1]:=c1;
s[2]:=c2;
memo1.Text:=memo1.Text+s;
end;
displen:=bfrelen;
end;
{procedure TForm1.Button12Click(Sender: TObject);
var
i:integer;
s:string;
bTmp:byte;
c1,c2:char;
begin
// MSComm1Comm(nil);
memo1.Text:='';
if bfrelen<=0 then exit;
for i:=0 to bfrelen-1 do begin
s:='00 ';
bTmp:=bytebf[i];
asm
mov ax,0
mov al, bTmp
push ax
shr al,4
cmp al,10
jge @@aaa1
add al,'0'
jmp @@end1
@@aaa1:add al,'A'-10
@@end1:mov c1,al
pop ax
and al,0fh
cmp al,10
jge @@aaa2
add al,'0'
jmp @@end2
@@aaa2:add al,'A'-10
@@end2:mov c2,al
end;
s[1]:=c1;
s[2]:=c2;
memo1.Text:=memo1.Text+s;
end;
button4.Enabled:=true;
button11.Enabled:=true;
end; }
{procedure TForm1.Button13Click(Sender: TObject);
var
F: TextFile;
i,cc:integer;
s:string;
c:byte;
begin
if bfrelen<=0 then exit;
SaveDialog1.Filter := '纯文本文件(*.TXT)|*.txt|All files (*.*)|*.*';
if SaveDialog1.Execute then begin
s:='';
if extractfileext(SaveDialog1.FileName)='' then SaveDialog1.FileName:=ChangeFileext(SaveDialog1.FileName,'.txt');
AssignFile(F, SaveDialog1.FileName); { File selected in dialog
for i:=0 to bfrelen-1 do begin
s:=s+byteto2xstr(bytebf[i])+' ';
end;
if fileexists(SaveDialog1.FileName) then
Append(f)
else Rewrite(F);
writeln(F,s);
closefile(f);
label21.Caption:= SaveDialog1.FileName;
end;
end; }
procedure TForm1.Button15Click(Sender: TObject);
var
i,f,l:integer;
scode:pkbytearray ;
begin
f:= strtoint(edit5.Text) ;
l:= strtoint(edit6.Text) ;
for i:=1 to l do begin
scode[i]:=bytebf[f+i-1];
end;
generatecrc(scode,l+2);
memo3.Text:='';
for i:=1 to l+2 do begin
memo3.Text:=memo3.Text+byteto2xstr(scode[i])+' ';
end;
end;
procedure generatecrc(var scode:pkbytearray;const iLen:integer);
var
crc:Word;
ia,ib,ie,i,iCount:integer;
caTemp:pkbytearray;
begin
scode[iLen-1]:=0;
scode[iLen]:=0;
crc:=0;
ia:=0;ib:=0;
for i:=1 to iLen do
caTemp[i]:=scode[i];
ie:=caTemp[1];
crc:=crc xor (ie shl 8);
crc:=crc xor caTemp[2];
for i:=1 to (iLen-2)*8 do begin
while iCount>2 do begin
if (caTemp[iCount] and 128)<>0 then
ia:=1
else
ia:=0;
caTemp[iCount]:=caTemp[iCount] shl 1;
if ib=1 then
caTemp[iCount]:= caTemp[iCount]+1;
ib:=ia;
iCount:=iCount-1;
end;
if (crc and 32768)<>0 then begin
crc:=crc shl 1;
if ia=1 then
crc:=crc+1;
crc:=crc xor 4129;
end else begin
crc:=crc shl 1;
if ia=1 then
crc:=crc+1;
end;
iCount:=iLen;
end;
scode[iLen-1]:=Hi(Crc);
scode[iLen]:=Lo(crc);
end;
procedure TForm1.Button16Click(Sender: TObject);
var
i,f,l:integer;
scode:pkbytearray ;
begin
f:= strtoint(edit5.Text) ;
l:= strtoint(edit6.Text) ;
for i:=1 to l do begin
scode[i]:=bytebf[f+i-1];
end;
generatecrc1(scode,l+2);
memo3.Text:='';
for i:=1 to l+2 do begin
memo3.Text:=memo3.Text+byteto2xstr(scode[i])+' ';
end;
end;
procedure generatecrc1(var scode:pkbytearray;const iLen:integer);
var
c,crc:Word;
b:byte;
i,j:integer;
begin
crc:=$FFFF;
for i:=0 to iLen-1 do begin
b:=scode[i+1];
asm
mov ax,0
mov al,b
mov c,ax
end;
crc:=crc xor c;
for j:=0 to 7 do begin
c:=crc and 1;
if c<>0 then begin
crc:=crc shr 1;
crc:=crc xor $a001;
end else
crc:=crc shr 1;
end;
end;
scode[iLen-1]:=Hi(Crc);
scode[iLen]:=Lo(crc);
end;
procedure TForm1.Button17Click(Sender: TObject);
var
i,ix:integer;
scode:pkbytearray ;
c:byte;
cc,cg:word;
s:string;
ia,il,ij:integer;
begin
ia:= strtoint(edit5.Text) ;
il:= strtoint(edit6.Text) ;
ij:= strtoint(edit7.Text) ;
if (ia<1) or (il+ia-1>bfrelen) then begin
MessageDlg('设置超出数据范围！', mtInformation,[mbOk], 0);
exit;
end;
i:=ComboBox5.ItemIndex+ij+1;
ix:=il div i;
if il<>ix * i then ix:=ix+1;
ia:=ia-1;
cg:=0;
memo2.Text:='';
for i:=0 to ix-1 do begin
if ComboBox5.ItemIndex=1 then begin
cc:=bytetoword(bytebf[ia])+(bytetoword(bytebf[ia+1]) shl 8);
memo2.Text:=memo2.Text+ byteto2xstr(bytebf[ia+1])+ byteto2xstr(bytebf[ia])+' ';
ia:=ia+2;
end else begin
cc:=bytetoword(bytebf[ia]);
memo2.Text:=memo2.Text+ byteto2xstr(bytebf[ia])+' ';
ia:=ia+1;
end;
case ComboBox6.ItemIndex of
0:cg:=cg xor cc;
1:cg:=cg + cc;
2:cg:=cg - cc;
3:cg:=cg * cc;
end;
ia:=ia+ij;
end;
if ComboBox5.ItemIndex=1 then
memo2.Text:=memo2.Text+' = '+ byteto2xstr(hi(cg))+ byteto2xstr(lo(cg))+' '
else
memo2.Text:=memo2.Text+' = '+ byteto2xstr(lo(cg))+' ';
end;
function bytetoword(c:byte):word;
var
cc:word;
begin
asm
mov ax,0
mov al,c
mov cc,ax
end;
result:=cc;
end;
function byteltoword(c:byte):word;
var
cc:word;
begin
asm
mov ax,0
mov al,c
and al,0fh
mov cc,ax
end;
result:=cc;
end;
procedure TForm1.Button18Click(Sender: TObject);
var
i:integer;
begin
memo3.Text:='';
for i:=0 to bfrelen-1 do begin
if bytebf[i]=$1E then begin
processcommand(i);
memo3.Text:=memo3.Text+chr($0d)+chr($0a);
end;
end;
end;
procedure TForm1.processcommand(it:integer);
var
i,f,l:integer;
c:byte;
xr,cc1,cc2,cc3,cc4:word;
s:string;
begin
f:=it;
xr:=bytetoword(bytebf[f+2]) + (bytetoword(bytebf[f+1]) shl 8);
case xr of
$000c,$0c00:
begin
l:=bytetoword(bytebf[f+5]) + (bytetoword(bytebf[f+4]) shl 8);
for i:=0 to ((l+6) div 2)-1+(l and 1) do begin
cc1:=cc1 xor bytetoword(bytebf[f]);
memo3.Text:=memo3.Text+ byteto2xstr(bytebf[f])+' ';
f:=f+1;
cc2:=cc2 xor bytetoword(bytebf[f]);
memo3.Text:=memo3.Text+ byteto2xstr(bytebf[f])+' ';
f:=f+1;
end;
memo3.Text:=memo3.Text+ ' - ';
for i:=0 to 1 do begin
memo3.Text:=memo3.Text+ byteto2xstr(bytebf[f]);
f:=f+1;
end;
memo3.Text:=memo3.Text+ '='+byteto2xstr(lo(cc1)) +byteto2xstr(lo(cc2));
end ;
end;
end;
{procedure TForm1.Button19Click(Sender: TObject);
var
s:string;
l,i:integer;
c:char;
w:word;
b:byte;
wflg:boolean;
begin
s:=trim(memo1.Text);
l:=length(s);
bfrelen:=0;
wflg:=false;
w:=0;
for i:=1 to l do begin
c:=s[i];
if ((c>='0') and (c<='9' )) or ((c>='A') and (c<='F' )) or ((c >='a') and (c<='f' )) then begin
asm
mov ax,w
mov ah,al
shl ah,4
mov al,c
cmp al,40h
jb @@is012
add al,9
@@is012:and al,0fh
add al,ah
mov ah,0
mov w,ax
end;
wflg:=true;
end else begin
if wflg then begin
b:=lo(w);
bytebf[bfrelen]:=b;
bfrelen:=bfrelen+1;
jjgg[bfrelen]:=0;
w:=0;
wflg:=false;
end;
end;
end;
if wflg then begin
b:=lo(w);
bytebf[bfrelen]:=b;
bfrelen:=bfrelen+1;
w:=0;
wflg:=false;
end;
memo1.Text:='';
Button12Click(Sender);
end; }
{procedure TForm1.Button14Click(Sender: TObject);
var
F: TextFile;
s:string;
ss:string;
begin
OpenDialog1.Filter := 'Text files (*.txt)|*.TXT|All files (*.*)|*.*';//'Text files (*.txt)|*.TXT';
if OpenDialog1.Execute then if fileexists(OpenDialog1.FileName) then begin
AssignFile(F, OpenDialog1.FileName); { File selected in dialog
Reset(F);
ss:='';
while not Eoln(f) do begin
readln(f,s);
ss:=ss+s+' ';
end;
closefile(f);
end;
memo1.Text:=ss;
label21.Caption:= OpenDialog1.FileName;
Button19Click(Sender);
end; }
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
cv:integer;
begin
myini.WriteString('EDIT','1',edit1.Text);
myini.WriteString('EDIT','2',edit2.Text);
myini.WriteString('EDIT','3',edit3.Text);
myini.WriteString('EDIT','4',edit4.Text);
myini.WriteString('EDIT','5',edit5.Text);
myini.WriteString('EDIT','6',edit6.Text);
myini.WriteString('EDIT','7',edit7.Text);
myini.WriteString('EDIT','8',edit8.Text);
myini.WriteInteger('COMBOBOX','1',comboBox1.ItemIndex);
myini.WriteInteger('COMBOBOX','2',comboBox2.ItemIndex);
myini.WriteInteger('COMBOBOX','3',comboBox3.ItemIndex);
myini.WriteInteger('COMBOBOX','4',comboBox4.ItemIndex);
myini.WriteInteger('COMBOBOX','5',comboBox5.ItemIndex);
myini.WriteInteger('COMBOBOX','6',comboBox6.ItemIndex);
case checkBox1.State of
cbUnchecked:cv:=0;
cbChecked: cv:=1;
else cv:=2;
end;
myini.WriteInteger('CHECKBOX','1',cv);
case checkBox2.State of
cbUnchecked:cv:=0;
cbChecked: cv:=1;
else cv:=2;
end;
myini.WriteInteger('CHECKBOX','2',cv);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -