📄 unit1.~pas
字号:
end
else
bsknstspnl4.Caption := ' STATUS: COM Port Closed';
end;
procedure TFrm_Main.ShowTX;
begin
bsknstspnl6.Caption := 'Tx:' + IntToStr(FTXNum);
end;
procedure EnumComPorts(Ports: TStrings);
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
begin
ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0,
KEY_READ, KeyHandle);
if ErrCode <> ERROR_SUCCESS then
raise ERegError.Create('打开串口列表的注册表项出错');
TmpPorts := TStringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Data);
Inc(Index);
end
else if ErrCode <> ERROR_NO_MORE_ITEMS then
raise ERegError.Create('打开串口列表的注册表项出错');
until (ErrCode <> ERROR_SUCCESS);
TmpPorts.Sort;
Ports.Assign(TmpPorts);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
end;
end;
procedure TFrm_Main.FormCreate(Sender: TObject);
begin
FRXNum := 0;
FTXNum := 0;
FShowText :=1; //关闭与打开mmo1的返回信息显示
//串口初始化
EnumComPorts(cbb1.Items); //得到串口列表
Cbb1.ItemIndex := 0;
cm1.CommName := cbb1.Text;
cbb2.ItemIndex := 7;
cm1.BaudRate := StrToInt(cbb2.Text);
cbb3.ItemIndex := 0;
Cm1.Parity := None;
Cbb4.ItemIndex := 3;
Cm1.ByteSize := _8;
Cbb5.ItemIndex := 0;
Cm1.StopBits := _1;
//按钮控制
btn1.Click;
end;
procedure TFrm_Main.btn2Click(Sender: TObject);
begin
FRXNum := 0;
FTXNum := 0;
ShowRX;
ShowTX;
end;
procedure TFrm_Main.tmr1Timer(Sender: TObject);
//var ec:Tcanvas;
begin
if (btn12.Enabled) and (mmo2.Text <> '') then
begin
btn12.Click;
end;
end;
procedure TFrm_Main.cbb2Change(Sender: TObject);
var
BaudRate: Integer;
begin
if cbb2.Text = 'Custom' then
begin
cbb2.SetFocus;
btn1.Enabled := false;
end
else
begin
if cbb2.ItemIndex > 0 then
//下面是自定义波特率的
if TryStrToInt(cbb2.Text, BaudRate) then
begin
cm1.BaudRate := BaudRate;
btn1.Enabled := true;
end
else
btn1.Enabled := false;
end;
end;
procedure TFrm_Main.cbb1Change(Sender: TObject);
begin
Cm1.CommName := cbb1.Text;
end;
procedure TFrm_Main.cbb3Change(Sender: TObject);
begin
//TParity = ( None, Odd, Even, Mark, Space );
Cm1.Parity := TParity(cbb3.ItemIndex);
end;
procedure TFrm_Main.cbb4Change(Sender: TObject);
begin
Cm1.ByteSize := TByteSize(cbb4.ItemIndex);
end;
procedure TFrm_Main.cbb5Change(Sender: TObject);
begin
//TStopBits = ( _1, _1_5, _2 );
Cm1.StopBits := TStopBits(cbb5.ItemIndex);
end;
procedure TFrm_Main.cbb2KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', #8]) then
Key := #0;
end;
procedure TFrm_Main.bsknchckrdbx2Click(Sender: TObject);
begin
bsknstspnl3.Caption:='通信模式';
SendString('AT+REST=1'+chr(13));
mmo1.Clear;
mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开,请给设备上电(如果已上电将直接进入通信模式)');
mmo1.Lines.Add('当前处于通讯状态...');
mmo2.Enabled:=True;
bskngrpbx2.Enabled:=True;
bskngrpbx4.Enabled:=False;
btn4.Enabled:=False;
tmr3.Enabled := False ;
btn6.Enabled := False ;
btn7.Enabled := False ;
btn8.Enabled := False ;
btn9.Enabled := False ;
btn10.Enabled := False ;
btn11.Enabled := False ;
btn5.Enabled := False ;
btn21.Enabled := False ;
btn20.Enabled := False ;
btn22.Enabled := False ;
btn4.Enabled := False ;
btn24.Enabled := False ;
end;
procedure TFrm_Main.bsknchckrdbx1Click(Sender: TObject);
begin
bsknstspnl3.Caption:='正在联机';
mmo2.Enabled:=False;
bskngrpbx2.Enabled:=False;
chk1.Checked := False ;
mmo1.Clear ;
mmo1.Lines.Add('>>> 串口('+cbb1.Text+')已打开,请给设备上电(如果已上电请重新上电)');
mmo1.Lines.Add('正在等待设备上电后进入配置状态...');
mmo2.Clear;
tmr3.Enabled := True ;
end;
procedure TFrm_Main.rb2Click(Sender: TObject);
begin
bskngrpbx5.Enabled:=False;
bskngrpbx6.Enabled:=True;
end;
procedure TFrm_Main.rb1Click(Sender: TObject);
begin
bskngrpbx5.Enabled:=True;
bskngrpbx6.Enabled:=False;
end;
procedure TFrm_Main.btn6Click(Sender: TObject);
begin
SendString('AT+BAUD=?'+chr(13));
end;
procedure TFrm_Main.btn13Click(Sender: TObject);
begin
mmo2.Clear;
end;
procedure TFrm_Main.btn16Click(Sender: TObject);
begin
mmo1.Clear;
end;
procedure TFrm_Main.btn12Click(Sender: TObject);
begin
if chk2.Checked then
SendString(HexStrToStr(mmo2.Text))
else
SendString(mmo2.Text);
end;
procedure TFrm_Main.cm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
Str: string;
begin
//Memo自动清空
if chk3.Checked and (mmo1.Lines.Count > 50) then
mmo1.Clear;
//下面两句是SPCOMM控件的接收数据的读取方法
//如果要读取到pchar时可以 (读取到字符数组时同理)
//var buf : pchar;
//GetMem(buf,BufferLength);
//Move(buffer^, buf^, bufferlength);
SetLength(Str, BufferLength);
Move(buffer^, PChar(@Str[1])^, bufferlength);
backStr:=Str;
if FShowText=1 then
begin
if chk4.Checked then
mmo1.Text := mmo1.Text + StrToHexStr(Str) + ' '
else
mmo1.Text := mmo1.Text + Str;
//下面几句是让mmo1下拉的,让接收的数据始终在最前面
mmo1.SelStart := Length(mmo1.Text);
mmo1.SelLength := 0;
mmo1.Perform(EM_SCROLLCARET, 0, 0);
end;
if (Pos('ERROR'+chr(13),Str) > 0) and (tmr3.Enabled = True) then
begin
tmr3.Enabled := False ;
bsknstspnl3.Caption:='联机成功';
btn3.Enabled := True ;
btn6.Enabled := True ;
btn7.Enabled := True ;
btn8.Enabled := True ;
btn9.Enabled := True ;
btn10.Enabled := True ;
btn11.Enabled := True ;
btn5.Enabled := True ;
btn21.Enabled := True ;
btn20.Enabled := True ;
btn22.Enabled := True ;
btn4.Enabled := True ;
bskngrpbx4.Enabled:=True ;
btn24.Enabled := True ;
end;
//判断是否进入工程模式,如果进入就不再发进入工程模式命令!
//if StrToHexStr(Str) ='49 6E 69 74 20 63 6F 6D 6D 61 6E 64 20 4C 69 73 74 3A 0D 0A ' then
// if pos(T,mmo1.text)>0 then
// showmessage('含有该字符串');
if Pos('Init command List:'+chr(13),Str) > 0 then //判断Str中有没有 Init command List:
//if copy(UpperCase(backStr),1,5)='ERROR'#$D#$A then
//if backStr = 'ERROR'#$D#$A then
//if Str = 'ERROR'+chr(13) then
begin
tmr3.Enabled := False ;
bsknstspnl3.Caption:='联机成功';
btn3.Enabled := True ;
btn6.Enabled := True ;
btn7.Enabled := True ;
btn8.Enabled := True ;
btn9.Enabled := True ;
btn10.Enabled := True ;
btn11.Enabled := True ;
btn5.Enabled := True ;
btn21.Enabled := True ;
btn20.Enabled := True ;
btn22.Enabled := True ;
btn4.Enabled := True ;
bskngrpbx4.Enabled:=True ;
btn24.Enabled := True ;
//FShowText :=1;
end;
//else
//if tmr3.Enabled = False then
//begin
//FShowText :=1;
//end;
FRXNum := FRXNum + bufferlength;
ShowRX;
end;
procedure TFrm_Main.btn17Click(Sender: TObject);
begin
if btn17.Caption = '停止显示' then
begin
btn17.Caption := '继续显示';
FShowText := 0;
end
else
begin
btn17.Caption := '停止显示';
FShowText := 1;
end;
end;
procedure TFrm_Main.chk1Click(Sender: TObject);
begin
tmr1.Enabled := chk1.Checked;
edt23.Enabled := not chk1.Checked;
end;
procedure TFrm_Main.edt23Change(Sender: TObject);
var
Interval: Integer;
begin
if TryStrToInt(edt23.Text, Interval) and (Interval > 0) then
begin
tmr1.Interval := Interval;
chk1.Enabled := true;
end
else
chk1.Enabled := false;
end;
procedure TFrm_Main.btn14Click(Sender: TObject);
begin
if bsknpndlg1.Execute then
edt24.Text := bsknpndlg1.FileName;
end;
procedure TFrm_Main.btn15Click(Sender: TObject);
begin
if FileExists(edt24.Text) then
SendFile(edt24.Text);
end;
procedure TFrm_Main.cbb6Change(Sender: TObject);
begin
if rb1.Checked = True then
begin
if cbb6.Text = '1' then
begin
lbl8.Visible := False ;
edt2.Visible := False ;
edt7.Visible := False ;
lbl9.Visible := False ;
edt3.Visible := False ;
edt8.Visible := False ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='2' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := False ;
edt3.Visible := False ;
edt8.Visible := False ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='3' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := False ;
edt4.Visible := False ;
edt9.Visible := False ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='4' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := True ;
edt4.Visible := True ;
edt9.Visible := True ;
lbl11.Visible := False ;
edt5.Visible := False ;
edt10.Visible := False ;
end;
if cbb6.text='5' then
begin
lbl8.Visible := True ;
edt2.Visible := True ;
edt7.Visible := True ;
lbl9.Visible := True ;
edt3.Visible := True ;
edt8.Visible := True ;
lbl10.Visible := True ;
edt4.Visible := True ;
edt9.Visible := True ;
lbl11.Visible := True ;
edt5.Visible := True ;
edt10.Visible := True ;
end;
end
else
begin
if cbb6.Text = '1' then
begin
lbl16.Visible := False ;
edt14.Visible := False ;
edt19.Visible := False ;
lbl17.Visible := False ;
edt15.Visible := False ;
edt20.Visible := False ;
lbl18.Visible := False ;
edt16.Visible := False ;
edt21.Visible := False ;
lbl19.Visible := False ;
edt17.Visible := False ;
edt22.Visible := False ;
end;
if cbb6.Text = '2' then
begin
lbl16.Visible := True ;
edt14.Visible := True ;
edt19.Visible := True ;
lbl17.Visible := False ;
edt15.Visible := False ;
edt20.Visible := False ;
lbl18.Visible := False ;
edt16.Visible := False ;
edt21.Visible := False ;
lbl19.Visible := False ;
edt17.Visible := False ;
edt22.Visible := False ;
end;
if cbb6.Text = '3' then
begin
lbl16.Visible := True ;
edt14.Visible := True ;
edt19.Visible := True ;
lbl17.Visible := True ;
edt15.Visible := True ;
edt20.Visible := True ;
lbl18.Visible := False ;
edt16.Visible := False ;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -