unit1.pas

Delphi7编程80例(完全版)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    Button1: TButton;
    Label1: TLabel;
    Button4: TButton;
    Comm1: TComm;
    Edit2: TEdit;
    Button5: TButton;
    StatusBar1: TStatusBar;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
  CommPort : string;
  hCommFile : THandle;
  hdcb:DCB;
begin
commport:=Edit1.Text;
hCommFile := CreateFile(PChar(CommPort),GENERIC_READ or GENERIC_WRITE,
                        0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
 //打开端口失败的处理
 if hCommFile =INVALID_HANDLE_VALUE then
  Statusbar1.SimpleText:='不能打开端口';
 GetCommState(hcommFile,hdcb);  //获取DCB结构信息
 Memo1.Clear;
 Memo1.Lines.Add('DCB结构大小是：'+IntToStr(hdcb.DCBlength)+#13#10+
                 '波特率大小是： '+IntToStr(hdcb.BaudRate)+#13#10+
                 'XON的临界值是：'+IntToStr(hdcb.XonLim)+#13#10+
                 'XOFF的临界值是：'+IntToStr(hdcb.XoffLim)+#13#10+
                 '字符位数是：'+IntToStr(hdcb.ByteSize)+#13#10+
                 '奇偶检验位：'+IntToStr(hdcb.Parity)+#13#10+
                 '停止位：'+IntToStr(hdcb.StopBits)+#13#10+
                 'XON字符：'+hdcb.XonChar+#13#10+
                 'XOFF字符：'+hdcb.XoffChar+#13#10+
                 '奇偶错误代替字符：'+hdcb.ErrorChar+#13#10+
                 '结束字符：'+hdcb.EofChar+#13#10+
                 '时间字符：'+hdcb.EvtChar+#13#10);
 CloseHandle(hcommfile);
 //关闭端口句柄，否则重新执行程序时会调用空句柄，不能得到正确的参数值
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  CommPort : string;
  hCommFile : THandle;
  Buffer : PCommConfig;
  size : DWORD;
begin
  CommPort := 'COM2';
  hCommFile := CreateFile(PChar(CommPort),
                          GENERIC_WRITE,
                          0,
                          nil,
                          OPEN_EXISTING,
                          FILE_ATTRIBUTE_NORMAL,
                          0);
  if hCommFile=INVALID_HANDLE_VALUE then
  begin
    Statusbar1.SimpleText:='不能打开 '+ CommPort;
    exit;
  end;
  GetMem(Buffer, sizeof(TCommConfig));
  GetCommConfig(hCommFile, Buffer^, size);
  FreeMem(Buffer, sizeof(TCommConfig));

  GetMem(Buffer, size);
  GetCommConfig(hCommFile, Buffer^, size);
  if CommConfigDialog(PChar(CommPort),Handle,Buffer^) = true then
    SetCommConfig(hCommFile, Buffer^, size);
  FreeMem(Buffer, size);
  CloseHandle(hCommFile);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  setComm : string;
  hsetFile : THandle;
  hsetdcb:DCB;
begin
  //设置断口信息
setcomm:=Edit1.Text;
hsetFile := CreateFile(PChar(setComm),GENERIC_READ or GENERIC_WRITE,
                        0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
 //打开端口失败的处理
 if hsetFile =INVALID_HANDLE_VALUE then
  Statusbar1.SimpleText:='不能打开端口';
 GetCommState(hsetFile,hsetdcb);
 hsetdcb.BaudRate:=2400;
 hsetdcb.StopBits:=2;
 hsetdcb.ByteSize:=4;
 SetCommState(hsetFile,hsetdcb);  //获取DCB结构信息
 closeHandle(hsetfile);           //关闭端口
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
comm1.StopComm;    //先关闭端口
{设置一些必要的参数}
Comm1.CommName:=Edit1.Text;
Comm1.BaudRate:=9600;
Comm1.ByteSize:=_8;
Comm1.StopBits:=_1;
Comm1.Parity:=None;
Try
 comm1.StartComm;    //打开端口
except
 raise Exception.create('打开端口'+comm1.CommName+'出错了');
end;
 Statusbar1.SimpleText:=Comm1.CommName+'打开了';
 Button5.Enabled:=True;
end;

procedure TForm1.Button5Click(Sender: TObject);
var str:string;
    count:WORD;
begin
str:=pchar(Edit2.Text);
count:=length(str);
If comm1.WriteCommData(pchar(str),count) Then
 Statusbar1.SimpleText:='已经发送'+IntToStr(count)+'字符'
 Else
 Statusbar1.SimpleText:='发送不成功';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Comm1.StopComm;  //关闭端口
end;

end.