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; 
        spDTR:   TShape; 
        spRTS:   TShape; 
        btnDTR:   TButton; 
        btnRTS:   TButton; 
        procedure   btnOpenPortClick(Sender:   TObject); 
        procedure   btnEndClick(Sender:   TObject); 
        procedure   btnDTRClick(Sender:   TObject); 
        procedure   btnRTSClick(Sender:   TObject); 
        procedure   FormCreate(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 
        Messagedlg( '通信端口已打开，不需再开 ',mtError,[mbOK],0); 
        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 
        Messagedlg( '打开通信端口错误!! ',mtError,[mbOK],0); 
        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 
      CloseHandle(hComm);         //关闭通信端口 
      close;                                   //结束程序 
end; 


//以下是控制DTR状态的按钮程序 
procedure   TForm1.btnDTRClick(Sender:   TObject); 
begin 
        //若通信端口未打开，则不作动作，并跳出 
        if   (hComm=0)   then   begin 
              Messagedlg( '通信端口未打开!! ',mtError,[mbOK],0); 
              exit; 
        end; 
        //判断DTRState值，输出状态后，将原值作转态 
        if   DTRState   then 
            begin 
              DOValue:=CLRDTR;   //设置DTR为低电压 
              EscapeCommFunction(   hComm,   DOValue   );//输出DTR状态 
              spDTR.Brush.Color:=clWhite;   //变更灯号的颜色 
            end 
        else 
            begin 
              DOValue:=SETDTR;   //设置DTR为高电压 
              EscapeCommFunction(   hComm,   DOValue   );//输出DTR的状态 
              spDTR.Brush.Color:=clRed;   //变更灯号的颜色 
            end; 
        DTRState:=(not   DTRState);   //将DTRState转态 
end; 

//以下是控制RTS状态的按钮程序 
procedure   TForm1.btnRTSClick(Sender:   TObject); 
begin 
        //若通信端口未打开，则不作动作，并跳出 
        if   (hComm=0)   then   begin 
              Messagedlg( '通信端口未打开!! ',mtError,[mbOK],0); 
              exit; 
        end; 
        //判断RTSState值，输出状态后，将原值作转态 
        if   RTSState   then 
            begin 
              DOValue:=CLRRTS;   //设置RTS为低电压 
              EscapeCommFunction(   hComm,   DOValue   );//输出RTS状态 
              spRTS.Brush.Color:=$FFFFFF;//变更灯号 
            end 
        else 
            begin 
              DOValue:=SETRTS;   //设置RTS为高电压 
              EscapeCommFunction(   hComm,   DOValue   );//输出RTS状态 
              spRTS.Brush.Color:=$00FF00;//变更灯号 
            end; 
        RTSState:=(not   RTSState);   //将RTSState转态 
end; 

//窗体建立时的初值设置 
procedure   TForm1.FormCreate(Sender:   TObject); 
begin 
    RTSState:=False;   //默认是低电压 
    DTRState:=False;   //默认是低电压 
end; 
end.