mainfrm.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls;

const
  WM_COMMNOTIFY = WM_USER + 365; // 通讯消息

type
  //接收串口数据的线程
  TRecvThread = Class(TThread)
  public
    procedure Execute;override;
  end;
  TfrmMain = class(TForm)
    pgcMain: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    btnOpenSend: TBitBtn;
    btnSendData: TBitBtn;
    btnCloseSend: TBitBtn;
    Label5: TLabel;
    edtSendCommName: TEdit;
    edtSendBaudRate: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    cmbSendByteSize: TComboBox;
    cmbSendStopBits: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    cmbSendParity: TComboBox;
    Panel2: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    btnOpenRecv: TBitBtn;
    btnRecvData: TBitBtn;
    btnCloseRecv: TBitBtn;
    edtRecvCommName: TEdit;
    edtRecvBaudRate: TEdit;
    cmbRecvByteSize: TComboBox;
    cmbRecvStopBits: TComboBox;
    cmbRecvParity: TComboBox;
    mmoRecv: TMemo;
    Panel3: TPanel;
    Panel4: TPanel;
    mmoSend: TMemo;
    Label11: TLabel;
    edtSend: TEdit;
    stbSend: TStatusBar;
    stbRecv: TStatusBar;
    procedure btnOpenSendClick(Sender: TObject);
    procedure btnSendDataClick(Sender: TObject);

    procedure btnCloseSendClick(Sender: TObject);
    procedure btnOpenRecvClick(Sender: TObject);
    procedure btnRecvDataClick(Sender: TObject);
    procedure btnCloseRecvClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtSendBaudRateExit(Sender: TObject);
    procedure edtRecvBaudRateExit(Sender: TObject);
  private
    //数据接收消息处理函数
    procedure WMCOMMNOTIFY(var Message: TMessage); message WM_COMMNOTIFY;
    procedure SetSendButton ;
    procedure SetRecvButton;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Post_Event: THandle;//创建事件同步对象的句柄
  hSend : THandle;//发送串口的句柄
  hRecv : THandle;//接收串口的句柄
  Read_os: Toverlapped;//重叠结构的变量
  Receive: Boolean; //开关变量，代表是否接收
implementation
{$R *.dfm}

//主窗体被创建时，初始化界面显示
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  edtSendCommName.text := 'COM1';
  edtSendBaudRate.text := '9600';
  cmbSendByteSize.ItemIndex :=3;
  cmbSendStopBits.ItemIndex :=0;
  cmbSendParity.ItemIndex :=0;

  edtRecvCommName.text := 'COM2';
  edtRecvBaudRate.text := '9600';
  cmbRecvByteSize.ItemIndex :=3;
  cmbRecvStopBits.ItemIndex :=0;
  cmbRecvParity.ItemIndex :=0;
end;

//互置发送按钮和输入框的有效性
procedure TfrmMain.SetSendButton ;
begin
  edtSendCommName.Enabled := not edtSendCommName.Enabled ;
  edtSendBaudRate.Enabled := not edtsendBaudRate.Enabled ;
  cmbSendByteSize.Enabled := not cmbSendByteSize.Enabled ;
  cmbSendStopbits.Enabled := not cmbSendStopbits.Enabled ;
  cmbSendParity.Enabled := not cmbSendParity.Enabled ;
  btnOpenSend.Enabled := not btnOpenSend.Enabled ;
  btnSendData.Enabled := not btnSendData.Enabled ;
  btnCloseSend.Enabled := not btnCloseSend.Enabled ;
end;

//互置接收按钮和输入框的有效性
procedure TfrmMain.SetRecvButton ;
begin
  edtRecvCommName.Enabled := not edtRecvCommName.Enabled ;
  edtRecvBaudRate.Enabled := not edtRecvBaudRate.Enabled ;
  cmbRecvByteSize.Enabled := not cmbRecvByteSize.Enabled ;
  cmbRecvStopbits.Enabled := not cmbRecvStopbits.Enabled ;
  cmbRecvParity.Enabled := not cmbRecvParity.Enabled ;
  btnOpenRecv.Enabled := not btnOpenRecv.Enabled ;
  btnRecvData.Enabled := not btnRecvData.Enabled ;
  btnCloseRecv.Enabled := not btnCloseRecv.Enabled ;
end;

//打开发送的串口
procedure TfrmMain.btnOpenSendClick(Sender: TObject);
var
  dcb: TDCB;
  Error: Boolean;
  CommName : string;
begin
  CommName := edtSendCommName.Text ;
  // 打开发送串口
  hSend := CreateFile(PChar(CommName), GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
  if hSend = INVALID_HANDLE_VALUE then
    raise Exception.Create('打开'+edtSendCommName.Text+'端口错误!');

  // 设置输入和输出缓冲区大小
  SetupComm(hSend, 1024, 1024);
  //设置串口的波特率、字符位数、奇偶校验、停止位
  GetCommState(hSend, dcb);
  dcb.BaudRate := strToInt(edtSendBaudRate.Text);
  dcb.ByteSize := strToInt(cmbSendByteSize.Text);
  dcb.StopBits := cmbSendStopBits.ItemIndex ;
  dcb.Parity := cmbSendParity.ItemIndex ;
  Error := SetCommState(hSend, dcb);
  if (not Error) then
    raise Exception.Create('设置'+edtSendCommName.text+'错误');
  stbSend.Panels[0].Text :=edtSendCommName.Text +'端口已打开';
  stbSend.Refresh ;
  SetSendButton;
end;

//向发送串口写数据
procedure TfrmMain.btnSendDataClick(Sender: TObject);
var
  dwNumberOfBytesWritten, dwNumberOfBytesToWrite,
  ErrorFlag, dwWhereToStartWriting: DWORD;
  pDataToWrite: PChar;
  write_os: Toverlapped;
begin
  dwWhereToStartWriting := 0;
  dwNumberOfBytesWritten := 0;
  //设置将要向串口里写的数据长度
  dwNumberOfBytesToWrite := edtSend.GetTextLen;
  if (dwNumberOfBytesToWrite = 0) then
    raise Exception.Create('发送缓冲区为空');
    //将edtcomm里的文本传到pDataToWrite缓冲区
    pDataToWrite := Pchar(edtSend.Text);

    FillChar(Write_Os, SizeOf(write_os), 'a');
    // 为重叠写创建事件对象
    Write_Os.hEvent := CreateEvent(nil, True, False, nil);
    //设置直到最后一个字符被发送
    SetCommMask(hSend, EV_TXEMPTY);
    repeat
       // 发送通讯数据
      if not WriteFile(hSend, pDataToWrite[dwWhereToStartWriting],
        dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
        @write_os) then
      begin
        ErrorFlag := GetLastError;
        if ErrorFlag <> 0 then
        begin
          if ErrorFlag = ERROR_IO_PENDING then
          begin
            WaitForSingleObject(Write_Os.hEvent, INFINITE);
            //等待设置好的事件发生
            GetOverlappedResult(hSend, Write_os,
              dwNumberOfBytesWritten, False);
          end
          else
            raise Exception.Create('发送数据失败');
        end;
      end;
      //减去已发生的数据长度
      Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten);
      //记录已发送的数据长度
      Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
    //直到全部发送完
    until (dwNumberOfBytesToWrite <= 0);
    mmoSend.Lines.Add('已发送：'+intToStr(dwWhereToStartWriting)+'个字节的数据');
end;

//关闭发送串口
procedure TfrmMain.btnCloseSendClick(Sender: TObject);
begin
  CloseHandle(hSend);
  stbSend.Panels[0].Text :=edtSendCommName.Text +'端口已关闭';
  stbSend.Refresh ;
  setSendButton;
end;

//打开接收串口
procedure TfrmMain.btnOpenRecvClick(Sender: TObject);
var
  dcb: TDCB;
  Error: Boolean;
  CommName : string;
begin
  CommName := edtRecvCommName.Text ;
  // 打开通讯端口
  hRecv := CreateFile(PChar(CommName),GENERIC_Read, 0,
    nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
  if hRecv = INVALID_HANDLE_VALUE then
    raise Exception.Create('打开'+edtSendCommName.Text+'端口错误!');
  Error := SetCommMask(hRecv,EV_RXCHAR);
  if (not Error) then
  raise Exception.Create('SetCommMask错误');
  // 设置缓冲区大小及主要通讯参数
  SetupComm(hRecv, 1024, 1024);
  //设置串口的波特率、字符位数、奇偶校验、停止位
  GetCommState(hRecv, dcb);
  dcb.BaudRate := strToInt(edtRecvBaudRate.Text);
  dcb.ByteSize := strToInt(cmbRecvByteSize.Text);
  dcb.StopBits := cmbRecvStopBits.ItemIndex ;
  dcb.Parity := cmbRecvParity.ItemIndex ;
  Error := SetCommState(hRecv, dcb);
  if (not Error) then
    raise Exception.Create('设置'+edtRecvCommName.text+'错误');
  stbRecv.Panels[0].Text :=edtSendCommName.Text +'端口已打开';
  stbRecv.Refresh ;
  SetRecvButton;
  btnRecvData.Enabled := True;
end;

//开始接收串口数据
procedure TfrmMain.btnRecvDataClick(Sender: TObject);
var
  dcb: TDCB;
  recvThread : TRecvThread;
begin
  FillChar(Read_Os, SizeOf(Read_Os), 0);
  Read_Os.Offset := 0;
  Read_Os.OffsetHigh := 0;
  // 创建Overlapped事件
  Read_Os.hEvent := CreateEvent(nil, true, False, nil);
  if Read_Os.hEvent = null then
  begin
    CloseHandle(hRecv);
    raise Exception.Create('CreateEvent Error!')
  end;
  //创建Post_Event事件
  Post_Event := CreateEvent(nil, True, True, nil);
  if Post_Event = null then
  begin
    CloseHandle(hRecv);
    CloseHandle(Read_Os.hEvent);
    raise Exception.Create('CreateEvent Error!')
  end;
  // 建立通信监视线程
  recvThread := TRecvThread.Create(false);
  //发送DTR信号
  EscapeCommFunction(hRecv, SETDTR);
  btnRecvData.Enabled := False;
  stbRecv.Panels[0].Text :='正在接收数据';
  stbRecv.Refresh;
end;

//关闭接收串口
procedure TfrmMain.btnCloseRecvClick(Sender: TObject);
begin
  Receive := False;
//关闭事件和串口
  CloseHandle(Read_Os.hEvent);
  CloseHandle(Post_Event);
  CloseHandle(hRecv);

  stbRecv.Panels[0].Text :=edtSendCommName.Text +'端口已关闭';
  stbRecv.Refresh ;

  SetRecvButton;
  btnRecvData.Enabled := False;
end;

//接收串口数据的线程执行体
procedure TRecvThread.Execute ;
var
  dwEvtMask, dwTranser: Dword;
  Ok: Boolean;
  Os: Toverlapped;
begin
  Receive := True;
  FillChar(Os, SizeOf(Os), 0);
  // 创建重叠读事件对象
  Os.hEvent := CreateEvent(nil, True, False, nil);
  if Os.hEvent = null then
  begin
    MessageBox(0, 'Os.Event Create Error !', 'Notice', MB_OK);
    Exit;
  end;
  if (not SetCommMask(hRecv, EV_RXCHAR)) then
  begin
    MessageBox(0, 'SetCommMask Error !', 'Notice', MB_OK);
    Exit;
  end;
  while (Receive) do
  begin
    dwEvtMask := 0;
    // 等待通讯事件发生
    if not WaitCommEvent(hRecv, dwEvtMask, @Os) then
    begin
      if ERROR_IO_PENDING = GetLastError then
        GetOverLappedResult(hRecv, Os, dwTranser, True)
    end;
    if ((dwEvtMask and EV_RXCHAR) = EV_RXCHAR) then
    begin
    // 等待允许传递WM_COMMNOTIFY通讯消息
      WaitForSingleObject(Post_event, INFINITE);
    // 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
      ResetEvent(Post_Event);
    // 传递WM_COMMNOTIFY通讯消息
      Ok := PostMessage(frmMain.Handle, WM_COMMNOTIFY, hRecv, 0);
      if (not Ok) then
      begin
        MessageBox(0, 'PostMessage Error !', 'Notice', MB_OK);
        Exit;
      end;
    end;
  end;
  CloseHandle(Os.hEvent); // 关闭重叠读事件对象
end;

// 数据接收消息处理函数
procedure TfrmMain.WMCOMMNOTIFY(var Message: TMessage);
var
  CommState: ComStat;
  dwNumberOfBytesRead: Dword;
  ErrorFlag: Dword;
  InputBuffer: array[0..1024] of Char;
  recvString : string;
begin
  if not ClearCommError(hRecv, ErrorFlag, @CommState) then
  begin
    MessageBox(0, 'ClearCommError !', 'Notice', MB_OK);
    PurgeComm(hRecv, Purge_Rxabort or Purge_Rxclear);
    Exit;
  end;
  if (CommState.cbInQue > 0) then
  begin
    fillchar(InputBuffer, CommState.cbInQue, #0);
      // 接收通讯数据
    if (not ReadFile(hRecv, InputBuffer, CommState.cbInQue,
      dwNumberOfBytesRead, @Read_os)) then
    begin
      ErrorFlag := GetLastError();
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
      begin
        Receive := False;
        raise Exception.Create('读串口数据出错!');
      end
      else
      begin
        WaitForSingleObject(hRecv, INFINITE); // 等待操作完成
        GetOverlappedResult(hRecv, Read_os,
          dwNumberOfBytesRead, False);
      end;
    end;
    if dwNumberOfBytesRead > 0 then
    begin
      Read_Os.Offset := Read_Os.Offset + dwNumberOfBytesRead;
      // 处理接收的数据
      InputBuffer[dwNumberOfBytesRead]:=#0;
      mmoRecv.Lines.Add('接收到：'+intToStr(dwNumberOfBytesRead)+'个字节的数据');
      mmoRecv.Lines.Add(strPas(inputBuffer));
    end;
  end;
 // 允许发送下一个WM_COMMNOTIFY消息
  SetEvent(Post_Event);
end;

//检查发送串口的波特率输入框输入的是否是整数
procedure TfrmMain.edtSendBaudRateExit(Sender: TObject);
var
  i: integer;
begin
  try
    i := strToInt(edtSendBaudRate.Text)
  except
    edtSendBaudRate.setfocus;
    raise Exception.Create('波特率设置错误');
  end;
end;

//检查接收串口的波特率输入框输入的是否是整数
procedure TfrmMain.edtRecvBaudRateExit(Sender: TObject);
var
  i: integer;
begin
  try
    i := strToInt(edtRecvBaudRate.Text)
  except
    edtRecvBaudRate.setfocus;
    raise Exception.Create('波特率设置错误');
  end;
end;

end.