📄 main.~pas
字号:
{*****************************************************************
*多功能强力系统下位机仿真 V1.0
*作 者:lee
*Email : quanhailee@126.com
*QQ : 63578649
*版 本:V1.0
*编写时间:2006/11/2
*说 明:本程序完全参照龚建伟VC版《串口调试助手V2.2》编写而成。
仅供学习测试之用。
******************************************************************}
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, Spin, ExtCtrls, ImgList, CPort, CPortCtl,ShellApi,
DBCtrls, DB,FileCtrl, DBTables, ADODB, Grids, DBGrids,strutils,
SkinCaption, WinSkinData;
type
TFrmMain = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
SpeedButton1: TSpeedButton;
Memo1: TMemo;
edStatus: TEdit;
edRx: TEdit;
edTx: TEdit;
Button5: TButton;
ImageList1: TImageList;
BitBtn1: TBitBtn;
GroupBox1: TGroupBox;
ComComboBox1: TComComboBox;
ComComboBox2: TComComboBox;
ComComboBox3: TComComboBox;
ComComboBox4: TComComboBox;
ComComboBox5: TComComboBox;
ComComboBox6: TComComboBox;
ComPort: TComPort;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
ComLed1: TComLed;
Label9: TLabel;
ComLed2: TComLed;
Label10: TLabel;
ComLed3: TComLed;
Label11: TLabel;
btnSwitch: TButton;
Panel5: TPanel;
Timer1: TTimer;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
DBMemo1: TDBMemo;
DBMemo2: TDBMemo;
DataSource1: TDataSource;
ADOQuery1: TADOQuery;
DBGrid1: TDBGrid;
Button6: TButton;
cbAutoClean: TCheckBox;
cbAutoSend: TCheckBox;
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label2: TLabel;
btnStopShow: TButton;
ComboBox1: TComboBox;
btnSend: TButton;
Label14: TLabel;
Button1: TButton;
SkinData1: TSkinData;
SkinCaption1: TSkinCaption;
Label12: TLabel;
Label13: TLabel;
procedure SpeedButton1Click(Sender: TObject);
procedure ComPortAfterOpen(Sender: TObject);
procedure ComPortAfterClose(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure btnSwitchClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ComComboBox1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure cbAutoSendClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure btnStopShowClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure ComPortRxChar(Sender: TObject; Count: Integer);
procedure ComboBox1Change(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SpinEdit1Exit(Sender: TObject);
private
FShowText:Boolean;
FRXNum:Integer;
FTXNum:Integer;
procedure ShowRX;
procedure ShowTX;
procedure ShowStatus;
procedure SendString(const str:string);
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
hh1:string='';
LS:boolean=false;
j: integer=0;
implementation
const
CWidth=713;
CHeight=470;
{$R *.dfm}
procedure TFrmMain.SendString(const str: string);
var
obj:PAsync;
begin
InitAsync(obj);
try
ComPort.WriteStrAsync(str,obj);
ComPort.WaitForAsync(obj);
FTXNum:=FTXNum+Length(str);
finally
DoneAsync(obj);
ShowTX;
end;
end;
procedure TFrmMain.SpeedButton1Click(Sender: TObject);
var
B:TBitmap;
begin
B:=TBitmap.Create; //创建建新图标 ,利用图标给它赋值 ,这段代码非常好,建议经常使用
if Self.FormStyle=fsNormal then
begin
Self.FormStyle:=fsStayOnTop;
SpeedButton1.Down:=True;
if ImageList1.GetBitmap(1,B) then
begin
SpeedButton1.Glyph.Assign(B);
end;
end
else if Self.FormStyle=fsStayOnTop then
begin
Self.FormStyle:=fsNormal;
SpeedButton1.Down:=False;
if ImageList1.GetBitmap(0,B) then
begin
SpeedButton1.Glyph.Assign(B);
end;
end;
B.Free;
end;
procedure TFrmMain.ComPortAfterOpen(Sender: TObject);
begin
btnSwitch.Caption:='关闭串口';
ShowStatus;
end;
procedure TFrmMain.ComPortAfterClose(Sender: TObject);
begin
btnSwitch.Caption:='打开串口';
ShowStatus;
end;
procedure TFrmMain.FormResize(Sender: TObject); //这个过程限定窗口不能被变小,从而阻止了变小是出现的按钮错位等现象
begin
if Height<CHeight then
Height:=CHeight;
if Width<CWidth then
Width:=CWidth;
end;
procedure TFrmMain.btnSwitchClick(Sender: TObject); //这是个最常用的开关按钮,配合上面文字显示使用
begin
if ComPort.Connected then
ComPort.Close
else ComPort.Open;
end;
procedure TFrmMain.BitBtn1Click(Sender: TObject);
begin
Close;
end;
procedure TFrmMain.Button6Click(Sender: TObject);
begin
Memo1.Clear;
if ComPort.Connected then
ComPort.ClearBuffer(True,False); //清空接收区,不清空发送区
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
FShowText:=True;
FRXNum:=0; //接受到的字符个数
FTXNum:=0; //发送的字符个数
end;
procedure TFrmMain.ShowRX;
begin
edRX.Text:='Rx:'+IntTostr(FRXNum); //
end;
procedure TFrmMain.ShowStatus;
begin
//掌握format函数的具体应用
if ComPort.Connected then
begin
edStatus.Text:=Format('STATUS:%s Opend %s %s %s %s %s',[ComComboBox1.Text,
ComComboBox2.Text,ComComboBox3.Text,ComComboBox4.Text,ComComboBox5.Text,
ComComboBox6.Text]);
end
else edStatus.Text:='STATUS:COM Port Closed';
end;
procedure TFrmMain.ShowTX;
begin
edTx.Text:='Tx:'+IntTostr(FTXNum); //发送出的字符个数
end;
procedure TFrmMain.Button5Click(Sender: TObject); //计数清零按钮的显示
begin
FRXNum:=0;
FTXNum:=0;
ShowRX;
ShowTX;
end;
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ComPort.OnAfterClose:=nil; //这句话是什么意思 ,关闭的时候关闭掉串口
end;
procedure TFrmMain.ComComboBox1Change(Sender: TObject);
begin
ShowStatus; //切换com口时自动显示状态
end;
procedure TFrmMain.Button1Click(Sender: TObject);
begin
timer1.Enabled:=true; //清空发送的字符重填一遍
end;
procedure TFrmMain.SpinEdit1Change(Sender: TObject);
begin
//Timer1.Interval:=SpinEdit1.Value; //发送周期 的改变
end;
procedure TFrmMain.cbAutoSendClick(Sender: TObject);
begin
Timer1.Enabled:=cbAutoSend.Checked; //自动发送总跟周期联系一起的
end;
procedure TFrmMain.Timer1Timer(Sender: TObject);
var
a,b,c:byte;
xx,yy:real;
ss:string;
begin
if (comport.Connected) and (j<dbmemo1.Lines.Count) then
begin
xx:=strtofloat(dbmemo1.Lines[j]);
c:=trunc(xx*100) mod 100;
a:=trunc(xx/256);
b:=(trunc(xx)) mod 256;
ss:='PE03'+chr(a)+chr(b)+chr(c)+'f';
comport.WriteStr(ss);
yy:=strtofloat(dbmemo2.Lines[j]);
c:=trunc(yy*100) mod 100;
a:=trunc(yy/256);
b:=(trunc(yy)) mod 256;
ss:='PF03'+chr(a)+chr(b)+chr(c)+'f';
comport.WriteStr(ss);
j:=j+1;
end;
if j=dbmemo1.Lines.Count then
begin
comport.WriteStr('WB');
adoquery1.Next;
Timer1.Enabled:=false;
j:=0;
end;
end;
procedure TFrmMain.btnStopShowClick(Sender: TObject);
begin
FShowText:=not FShowText; //首先对 FShowText取反,
if FShowText then
btnStopShow.Caption:='停止显示'
else btnStopShow.Caption:='继续显示';
end;
function AddBackSlash(const S: string): string; // 给文件尾后加路径符号'\'
begin
Result := S;
if S<>'' then
begin
if Result[Length(Result)] <> '\' then // 如果第一个字符不是路径符号
Result := Result + '\';
end;
end;
function HexStrToStr(const S:string):string; //16进制字符串转换成字符串
var
t:Integer;
ts:string;
M,Code:Integer;
begin
t:=1;
Result:='';
while t<=Length(S) do
begin
while not (S[t] in ['0'..'9','A'..'F','a'..'f']) do
inc(t);
if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
ts:='$'+S[t]
else
ts:='$'+S[t]+S[t+1];
Val(ts,M,Code);
if Code=0 then
Result:=Result+Chr(M);
inc(t,2);
end;
end;
procedure TFrmMain.btnSendClick(Sender: TObject);
var
a,b,c:byte;
xx,yy:real;
i:integer;
ss:string;
begin
if comport.Connected then begin
for i:=0 to dbmemo1.Lines.Count-1 do
begin
xx:=strtofloat(dbmemo1.Lines[i]);
c:=trunc(xx*100) mod 100;
a:=trunc(xx/256);
b:=(trunc(xx)) mod 256;
ss:='PE03'+chr(a)+chr(b)+chr(c)+'f';
comport.WriteStr(ss);
yy:=strtofloat(dbmemo2.Lines[i]);
c:=trunc(yy*100) mod 100;
a:=trunc(yy/256);
b:=(trunc(yy)) mod 256;
ss:='PF03'+chr(a)+chr(b)+chr(c)+'f';
comport.WriteStr(ss);
end;
comport.WriteStr('WB');
adoquery1.Next;
end
else
MessageBox(handle,'串口尚未打开,请先打开再执行此动作','警告',mb_IconInformation+mb_YesNo);
end;
function StrToHexStr(const S:string):string; //字符串转换16进制
//字符串转换成16进制字符串
var
I:Integer;
begin
for I:=1 to Length(S) do
begin
if I=1 then
Result:=IntToHex(Ord(S[1]),2)
else Result:=Result+' '+IntToHex(Ord(S[I]),2);
end;
end;
procedure TFrmMain.ComPortRxChar(Sender: TObject; Count: Integer); // 接受数据,并且显示
var
Str,ss: String;
sr:string;
i:integer;
begin
if cbAutoClean.Checked and (Memo1.Lines.Count > 4) then
Memo1.Clear;
ComPort.ReadStr(Str, Count);
if FShowText then
begin
sr:=copy(str,1,2);
if sr='QF' then
begin
SendString('QS');
ss:='成功实现联机可以进行通讯';
end;
if sr='JL' then
begin
SendString('OK');
ss:='需要进行隔距校订';
end;
if sr='SE' then
begin
SendString('OK');
ss:='进行拉伸试验';
btnSend.Click;
end;
sr:=copy(str,1,4);
if sr='CDCS' then
begin
ls:=true;
hh1:=hh1+str;
exit;
end;
if LS=true then
begin
hh1:=hh1+str;
if ansicontainstext(hh1,'##') then
begin
sr:=copy(hh1,5,2);
ss:='试验方式为'+sr;
i:=pos('#',hh1);
hh1[i]:='_';
j:=pos('#',hh1);
sr:=copy(hh1,i+3,j-i-3);
ss:=ss+'试验时间为'+sr;
i:=pos('#',hh1);
hh1[i]:='_';
j:=pos('#',hh1);
sr:=copy(hh1,i+3,j-i-3);
ss:=ss+'试验隔距为'+sr;
i:=pos('#',hh1);
hh1[i]:='_';
j:=pos('#',hh1);
sr:=copy(hh1,i+3,j-i-3);
ss:=ss+'试验速度为'+sr;
end;
end;
Memo1.Text := Memo1.Text + ss;
end;
FRXNum:=FRXNum+Count;
ShowRX;
end;
procedure TFrmMain.ComboBox1Change(Sender: TObject);
begin
ADOQuery1.Active:=false;
case ComboBox1.ItemIndex of
0: adoquery1.Parameters[0].Value:=20;
1: adoquery1.Parameters[0].Value:=30;
2: adoquery1.Parameters[0].Value:=31;
3: adoquery1.Parameters[0].Value:=32;
4: adoquery1.Parameters[0].Value:=33;
end;
ADOQuery1.Active:=true;
end;
procedure TFrmMain.FormShow(Sender: TObject);
begin
adoquery1.Parameters[0].Value:=20;
ADOQuery1.Active:=true;
end;
procedure TFrmMain.SpinEdit1Exit(Sender: TObject);
begin
Timer1.Interval:=SpinEdit1.Value; //发送周期 的改变
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -