📄 unit1.~pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
rdCOM: TRadioGroup;
Label1: TLabel;
Label2: TLabel;
btnOpenPort: TButton;
btnEnd: TButton;
spCD: TShape;
spDSR: TShape;
spCTS: TShape;
Label3: TLabel;
Label4: TLabel;
spRI: TShape;
Timer1: TTimer;
procedure btnOpenPortClick(Sender: TObject);
procedure btnEndClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
DTRState:Boolean;
RTSState:Boolean;
DOValue:DWORD;
public
{ Public declarations }
procedure OpenComm; //打开通信端口
end;
var
Form1: TForm1;
hComm: THandle;
implementation
{$R *.DFM}
//以下是打开通信端口的程序
procedure TForm1.btnOpenPortClick(Sender: TObject);
begin
//若通信端口已打开,则不需要再打开
if (hComm<>0) then begin
ShowMessage('通信端口已打开!不需再开!');
exit;
end;
OpenComm; //打开通信端口的子程序
//先将DTR/RTS的电压降成低电压
EscapeCommFunction( hComm, CLRDTR); //将DTR降为低电压
EscapeCommFunction( hComm, CLRRTS); //将RTS降为低电压
end;
//以下是打开通信端口的实际程序代码,采用API
procedure TForm1.OpenComm;
var
cc:TCOMMCONFIG; //定义通信组态变量
Temp:string;
begin
// 选择所要打开的COM
Temp:='COM'+inttostr(rdcom.ItemIndex+1);
// 以Create函数打开COM
hComm:=CreateFile(PChar(Temp), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, 0, 0);
// 判断COM 是否顺利打开
if (hComm = INVALID_HANDLE_VALUE) then begin
MessageBox (0, '打开通信端口错误!!','',MB_OK);
exit;
end;
//以下设置通信端口的参数
GetCommState(hComm,cc.dcb); // 得知目前COM 的状态
cc.dcb.BaudRate:=CBR_9600; // 设置波特率为9600
cc.dcb.ByteSize:=8; // 字节为 8 bit
cc.dcb.Parity:=NOPARITY; // Parity 为 None
cc.dcb.StopBits:=ONESTOPBIT; // 1 个Stop bit
//若分别控制DTR、RTS,必须不能激活HandShaking
cc.dcb.Flags:=1; //此动作可关闭HandShaking等设置
//以下将通信端口参数写入实际硬件
if not SetCommState(hComm, cc.dcb) then begin // 设置COM 的状态
MessageBox (0, '通信端口设置错误!!!','',MB_OK);
CloseHandle(hComm);
exit;
end;
end;
//以下是结束按钮的动作
procedure TForm1.btnEndClick(Sender: TObject);
begin
SetCommMask(hcomm,$0); //取消所有的事件设定
CloseHandle(hComm); //关闭通信端口
close; //结束程序
end;
//窗体建立时的初值设定
procedure TForm1.FormCreate(Sender: TObject);
begin
RTSState:=False; //预设是低电压
DTRState:=False; //预设是低电压
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
lStatus:DWORD; //输入线路状态变量
begin
if (hComm =0) then exit ;
if GetCommModemStatus(hComm,lStatus) then
begin
//检查CTS状态
if ( lStatus and MS_CTS_ON )= MS_CTS_ON then
spCTS.Brush.Color :=clRed
else spCTS.Brush.Color :=clWhite;
//检查DSR状态
if ( lStatus and MS_DSR_ON )=MS_DSR_ON then
spDSR.Brush.Color :=clRed
else spDSR.Brush.Color :=clWhite;
//检查RI状态
if ( lStatus and MS_RING_ON )=MS_RING_ON then
spRI.Brush.Color :=clRed
else spRI.Brush.Color :=clWhite;
//检查CD状态
if ( lStatus and MS_RLSD_ON )=MS_RLSD_ON then
spCD.Brush.Color :=clRed
else spCD.Brush.Color :=clWhite;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -