⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 自己编写的计算机与单片机通讯时
💻 ~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 + -