在好例子网,分享、交流、成长!
您当前所在位置:首页Pascal 开发实例Delphi数据库编程 → delphi 串口通信程序源码

delphi 串口通信程序源码

Delphi数据库编程

下载此实例
  • 开发语言:Pascal
  • 实例大小:0.24M
  • 下载次数:83
  • 浏览次数:1131
  • 发布时间:2018-12-21
  • 实例类别:Delphi数据库编程
  • 发 布 人:leisg
  • 文件格式:.rar
  • 所需积分:2
 相关标签: 串口 通信 串口通信 程序

实例介绍

【实例简介】


  本程序完全参照龚建伟《串口调试助手V2.2》制作而成,原软件是用VC编写的,现用Delphi编写,可作为学习串口编程的一个例子与工具使用。

   其中用到串口控件为ComPort,该控件为开源软件,各大网站均有下载,目前最新版为3.0。


【实例截图】

from clipboard

【核心代码】

{*****************************************************************
*串口调试助手V1.0
*作    者:sky
*Email   : mastersky@21cn.com
*QQ      : 11116580
*版    本:V1.0
*编写时间:2005/12/19
*说    明:本程序完全参照龚建伟VC版《串口调试助手V2.2》编写而成。
           仅供学习测试之用。
******************************************************************}

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, Spin, ExtCtrls, ImgList, CPort, CPortCtl,ShellApi,
  FileCtrl;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Memo1: TMemo;
    cbsendHex: TCheckBox;
    cbAutoSend: TCheckBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    Button1: TButton;
    Panel4: TPanel;
    btnSend: TButton;
    Button3: TButton;
    Button4: TButton;
    edSendFile: TEdit;
    SpeedButton1: TSpeedButton;
    Memo2: 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;
    Button6: TButton;
    cbRecHex: TCheckBox;
    cbAutoClean: TCheckBox;
    btnStopShow: TButton;
    Button8: TButton;
    Button9: TButton;
    edPath: TEdit;
    BitBtn2: TBitBtn;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure SpeedButton1Click(Sender: TObject);
    procedure ComPortAfterOpen(Sender: TObject);
    procedure ComPortAfterClose(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnSwitchClick(Sender: TObject);
    procedure Label12Click(Sender: TObject);
    procedure Label13Click(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 Button9Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure BitBtn2Click(Sender: TObject);
  private
    FShowText:Boolean;
    FRXNum:Integer;
    FTXNum:Integer;
    TmpStr:String;
    procedure ShowRX;
    procedure ShowTX;
    procedure ShowStatus;
    procedure SendFile(const filename:string);
    procedure SendString(const str:string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

const
  CWidth=713;
  CHeight=470;

{$R *.dfm}

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.Label12Click(Sender: TObject);
begin
  ShellExecute(0,'open','mailto: mastersky@21cn.com?subject=串口调试助手Delphi版',
               NIL, NIL, SW_SHOWNORMAL);
end;

procedure TFrmMain.Label13Click(Sender: TObject);
begin
  ShellExecute(0,'open','http://www.delphipages.cn',
               NIL, NIL, SW_SHOWNORMAL);
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
  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;
end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  Memo2.Clear;
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);
begin
  if Memo2.Text<>'' then
    btnSend.Click;
end;

procedure TFrmMain.btnStopShowClick(Sender: TObject);
begin
  FShowText:=not FShowText;
  if FShowText then
    btnStopShow.Caption:='停止显示'
  else btnStopShow.Caption:='继续显示';
end;

procedure TFrmMain.Button9Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := edPath.Text;
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
    edPath.Text := Dir;
end;

function AddBackSlash(const S: string): string;
begin
  Result := S;
  if S<>'' then
  begin
    if Result[Length(Result)] <> '\' then
      Result := Result   '\';              
  end;
end;

procedure TFrmMain.Button8Click(Sender: TObject);
var
  S:string;
begin
  S:=AddBackSlash(edPath.Text);
  if not DirectoryExists(S) then
    CreateDir(S);
  S:=S 'Rec' FormatDateTime('yymmddhhssnn',Now) '.txt';
  Memo1.Lines.SaveToFile(S);
  ShowMessage(S '已保存');
end;

procedure TFrmMain.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edSendFile.Text:=OpenDialog1.FileName;
end;

procedure TFrmMain.Button4Click(Sender: TObject);
begin
  if FileExists(edSendFile.Text) then
    SendFile(edSendFile.Text);
end;

procedure TFrmMain.SendFile(const filename: string);
var
  S:TStringList;
begin
  S:=TStringList.Create;
  try
    S.LoadFromFile(filename);
    SendString(S.Text);
  finally
    S.Free;
  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);
begin
  if cbsendHex.Checked then
    SendString(HexStrToStr(Memo2.Text))
  else
    SendString(Memo2.Text);
end;

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;

function StrToHexStr(const S:string):string;
//字符串转换成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: String;
begin
  ComPort.ReadStr(Str, Count);
  if FShowText then
  begin
    if cbRecHex.Checked then
      Memo1.Text:=Memo1.Text StrToHexStr(Str)
    else
      Memo1.Text := Memo1.Text   Str;
  end;
  TmpStr:=TmpStr Str;
  FRXNum:=FRXNum Count;
  showmessage(inttostr(FRXNum));
  ShowRX;
end;

procedure TFrmMain.BitBtn2Click(Sender: TObject);
begin
  ShellExecute(0,'open',PChar(ExtractFilePath(Application.ExeName) 'help.htm'),
               NIL, NIL, SW_SHOWNORMAL);
end;

end.

实例下载地址

delphi 串口通信程序源码

不能下载?内容有错? 点击这里报错 + 投诉 + 提问

好例子网口号:伸出你的我的手 — 分享

网友评论

发表评论

(您的评论需要经过审核才能显示)

查看所有0条评论>>

小贴士

感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。

  • 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
  • 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
  • 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
  • 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明

;
报警