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

📄 ucommtest.pas

📁 DELPHI串口通讯程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit uCommTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SPComm, ExtCtrls, Buttons, ToolWin, ComCtrls, Menus,
  ActnList, Inifiles;

type
  TCommTestFrm = class(TForm)
    Comm1: TComm;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    CmbBaudrate: TComboBox;
    CmbSendComm: TComboBox;
    RadioByteSize: TRadioGroup;
    RadioStopBits: TRadioGroup;
    RadioParity: TRadioGroup;
    BTNResetCommSet: TBitBtn;
    BTNSaveCommSet: TBitBtn;
    Comm2: TComm;
    CoolBar1: TCoolBar;
    Label5: TLabel;
    CmbRecvComm: TComboBox;
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    BTNOpen: TBitBtn;
    BTNSave: TBitBtn;
    BTNTest: TBitBtn;
    BTNStartRecv: TBitBtn;
    BTNStopSend: TBitBtn;
    BTNStartSend: TBitBtn;
    BTNStopRecv: TBitBtn;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Splitter1: TSplitter;
    GroupBox3: TGroupBox;
    Memo2: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    EditAck1: TEdit;
    EditAck2: TEdit;
    EditAck3: TEdit;
    EditAck4: TEdit;
    EditAck5: TEdit;
    EditAck6: TEdit;
    BTNSaveAck: TBitBtn;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    Test: TMenuItem;
    SendMenu: TMenuItem;
    RecvMenu: TMenuItem;
    HelpMenu: TMenuItem;
    OpenFileMenu: TMenuItem;
    SaveFileMenu: TMenuItem;
    N6: TMenuItem;
    ExitMenu: TMenuItem;
    TestComMenu: TMenuItem;
    StartSendMenu: TMenuItem;
    StopSendMenu: TMenuItem;
    StartRecvMenu: TMenuItem;
    StopRecvMenu: TMenuItem;
    HelpWinMenu: TMenuItem;
    AboutMenu: TMenuItem;
    ActionList1: TActionList;
    OpenFileAction: TAction;
    SaveFileAction: TAction;
    SetACKAction: TAction;
    TestCommAction: TAction;
    StartSendAction: TAction;
    StopSendAction: TAction;
    StartReciveAction: TAction;
    StopReciveAction: TAction;
    HelpAction: TAction;
    ViewMenu: TMenuItem;
    SendWinMenu: TMenuItem;
    RecvWinMenu: TMenuItem;
    N16: TMenuItem;
    CommSetMenu: TMenuItem;
    N18: TMenuItem;
    ToolBarMenu: TMenuItem;
    AboutAction: TAction;
    ExitAction: TAction;
    Panel2: TPanel;
    BTNSaveLeft: TBitBtn;
    Panel3: TPanel;
    BTNClearRight: TBitBtn;
    BTNClearLeft: TBitBtn;
    BTNSaveRight: TBitBtn;
    N1: TMenuItem;
    F1: TMenuItem;
    N2: TMenuItem;
    F2: TMenuItem;
    Label4: TLabel;
    procedure BitBtn11Click(Sender: TObject);
    procedure Splitter1Moved(Sender: TObject);
    procedure AboutActionExecute(Sender: TObject);
    procedure HelpActionExecute(Sender: TObject);
    procedure ExitActionExecute(Sender: TObject);
    procedure OpenFileActionExecute(Sender: TObject);
    procedure SaveFileActionExecute(Sender: TObject);
    procedure BTNClearRightClick(Sender: TObject);
    procedure BTNClearLeftClick(Sender: TObject);
    procedure BTNSaveLeftClick(Sender: TObject);
    procedure BTNSaveCommSetClick(Sender: TObject);
    procedure BTNResetCommSetClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BTNSaveAckClick(Sender: TObject);
    procedure StartSendActionExecute(Sender: TObject);
    procedure StopReciveActionExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StopSendActionExecute(Sender: TObject);
    procedure Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure TestCommActionExecute(Sender: TObject);
    procedure StartReciveActionExecute(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure SendWinMenuClick(Sender: TObject);
    procedure CommSetMenuClick(Sender: TObject);
    procedure ToolBarMenuClick(Sender: TObject);
    procedure RecvWinMenuClick(Sender: TObject);
    procedure Comm1SendDataEmpty(Sender: TObject);
    procedure Comm2RequestHangup(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CommTestFrm: TCommTestFrm;
  ViewString: string;
  i, NextNum: Integer;
  Recvbuf, Sendbuf: array[1..6] of byte;
  Ini: TIniFile;
  BaudRate : Cardinal;
  SendComm, RecvComm : string;
  ByteSize, StopBits : String;
  Parity, Testing : Boolean;
implementation

uses uHelp, uAbout;
{$R *.dfm}

procedure TCommTestFrm.BitBtn11Click(Sender: TObject);
begin
  HelpFrm.Show;
end;

procedure TCommTestFrm.Splitter1Moved(Sender: TObject);
begin
  StatusBar1.Panels[1].Width := GroupBox1.Width;
end;

procedure TCommTestFrm.AboutActionExecute(Sender: TObject);
begin
  AboutFrm := TAboutFrm.Create(Application);
  AboutFrm.Show;
end;

procedure TCommTestFrm.HelpActionExecute(Sender: TObject);
begin
  HelpFrm := THelpFrm.Create(Application);
  HelpFrm.Show;
end;

procedure TCommTestFrm.ExitActionExecute(Sender: TObject);
begin
  Close;
end;

procedure TCommTestFrm.OpenFileActionExecute(Sender: TObject);
var
F : TextFile;
tmpLine: String;
begin
  Memo1.Clear;
  OpenDialog1.Title := '打开一个要传送的文本文件!';
  if OpenDialog1.Execute then
    begin
      AssignFile(F, OpenDialog1.FileName);
      StatusBar1.Panels[1].Text := OpenDialog1.FileName;
      Reset(F);
       //读入文件内容到Memo1中
      while not Eof(F) do
      begin
        tmpLine := '';
        ReadLn(F, tmpLine);
        Memo1.Lines.Add(tmpLine);
      end;
      CloseFile(F);
    end;
end;

procedure TCommTestFrm.SaveFileActionExecute(Sender: TObject);
begin
  if Trim(Memo2.Lines.Text) <> '' then
  begin
    SaveDialog1.Title := '将接收到的内容保存到文本文件中!';
    with SaveDialog1 do
      if Execute then
      begin
        StatusBar1.Panels[2].Text := SaveDialog1.FileName;
       //将Memo2中内容保存到文件中
        Memo2.Lines.SaveToFile(SaveDialog1.FileName);
      end;
  end;
end;

procedure TCommTestFrm.BTNClearRightClick(Sender: TObject);
begin
  Memo2.Clear;
  StatusBar1.Panels[2].Text := '';
end;

procedure TCommTestFrm.BTNClearLeftClick(Sender: TObject);
begin
  Memo1.Clear;
  StatusBar1.Panels[1].Text := '';
end;

procedure TCommTestFrm.BTNSaveLeftClick(Sender: TObject);
begin
  if Trim(Memo1.Lines.Text) <> '' then
  begin
    SaveDialog1.Title := '将即将发送的内容保存到文本文件中!';
    with SaveDialog1 do
      if Execute then
      begin
        StatusBar1.Panels[1].Text := SaveDialog1.FileName;
       //将Memo1中内容保存到文件中
        Memo1.Lines.SaveToFile(SaveDialog1.FileName);
      end;
  end;
end;

procedure TCommTestFrm.BTNSaveCommSetClick(Sender: TObject);
begin
  SendComm := CmbSendComm.text;
  RecvComm := CmbRecvComm.Text;
  i := CmbBaudRate.ItemIndex;
  BaudRate := strtoint(CmbBaudRate.Items[i]);
  if RadioParity.ItemIndex =0 then
      Parity := True
  else  Parity := False;
  if RadioByteSize.ItemIndex =0 then
      ByteSize := '_8'
  else ByteSize := '_7';
  if RadioStopBits.ItemIndex = 0 then
      StopBits := '_1'
  else if RadioStopBits.ItemIndex = 1 then
      StopBits := '_1_5'
  else StopBits := '_2';
  Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -