unit1.~pas

DELPHI 串口程序 小程序 我个人做的想程序给大家看看

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Image1: TImage;
    GroupBox1: TGroupBox;
    BitBtn1: TBitBtn;
    ComboBox2: TComboBox;
    ComboBox5: TComboBox;
    ComboBox6: TComboBox;
    ComboBox4: TComboBox;
    ComboBox3: TComboBox;
    Label5: TLabel;
    Label8: TLabel;
    Label2: TLabel;
    Label7: TLabel;
    Label6: TLabel;
    Shape1: TShape;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    GroupBox3: TGroupBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    BitBtn4: TBitBtn;
    Edit1: TEdit;
    Label3: TLabel;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    receiver: TMemo;
    Msend: TMemo;
    BitBtn9: TBitBtn;
    StaticText1: TStaticText;
    Label1: TLabel;
    XPManifest1: TXPManifest;
    Timer1: TTimer;
    procedure BitBtn2Click(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox6Change(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn9Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure  rceiver(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   TemDCB  :TCOMMConfig;
   temB    : Boolean;
  end;
var
  Form1: TForm1;
  fhandle:longword;
  temB   :Boolean;
implementation
  uses unit2;
{$R *.dfm}
//*******************************************************************
//          Clear
///*****************************************************************
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
   receiver.Lines.Clear;
end;
//*******************************************************************
//        baud rate
///*****************************************************************
procedure TForm1.ComboBox4Change(Sender: TObject);
begin
     if ComboBox4.Text='9600' then
     begin
       temDCB.dcb.BaudRate := CBR_9600;
     end
     else
     if ComboBox4.Text='600' then
     begin
       temDCB.dcb.BaudRate := CBR_600;
     end
     else
     if ComboBox4.Text='1200' then
     begin
       temDCB.dcb.BaudRate := CBR_1200;
     end
     else
     if ComboBox4.Text='4800' then
     begin
       temDCB.dcb.BaudRate := CBR_4800;
     end;
end;
//*******************************************************************
//        1 2
///*****************************************************************
procedure TForm1.ComboBox6Change(Sender: TObject);
begin
case ComboBox6.ItemIndex of
    1: temDCB.dcb.Parity   := ODDPARITY;
    2: temDCB.dcb.Parity   := EVENPARITY;
    3: temDCB.dcb.Parity   := NOPARITY;
    end;
end;
//*******************************************************************
//        RICEIVER
///*****************************************************************
 procedure  TForm1.rceiver(Sender: TObject);
 var
    shuzu : array[0..100] of char;
    Temp:string;
    cs:TCOMSTAT;
    nBytesRead,dwError:LongWORD ;
begin
    ClearCommError(fhandle,dwError,@CS);  //取得状态
    readfile(fhandle,shuzu,cs.cbInQue,nBytesRead,nil);
    Temp:=Copy(shuzu,1,cs.cbInQue);
    receiver.text:=Temp;
end;
//*******************************************************************
//        open
///*****************************************************************
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if BitBtn1.Caption = '打开串口' then
  begin
       shape1.brush.color:=clred;//变颜色
       temB    := True;
       BitBtn1.Caption := '关闭串口';
       fhandle := CreateFile(Pchar(Trim(Combobox3.Text)),//打开串口
             GENERIC_READ or GENERIC_WRITE,
             0,Nil,OPEN_EXISTING,0,0);
       temB := GetCommState(FHandle,TemDCB.DCB);//取得串口状态
      if ComboBox3.ItemIndex=-1 then
      begin
          showmessage('选择串口后再进行打开操作');
          combobox3.SetFocus;
          exit;
      end;
      if fhandle = InValid_Handle_value then
      begin
          showmessage('打开错误');
          exit;
      end;
      if not temB then
      begin
          showmessage('error');
          Exit;
      end
      else
      begin
         SetCommState(FHandle,TemDCB.dcb);//用于配置串口
      end;
 end
 else if BitBtn1.Caption = '关闭串口' then
 begin
       CloseHandle(fhandle); //关闭串口 true  close
       shape1.brush.color:=clwhite;
       temB   := False;
       BitBtn1.Caption := '打开串口';
 end;
end;
//*******************************************************************
//       close
///*****************************************************************
procedure TForm1.BitBtn9Click(Sender: TObject);
begin
   close;
end;
//*******************************************************************
//        send
///*****************************************************************
procedure TForm1.BitBtn4Click(Sender: TObject);
var
    lrc :LongWord;
begin
    if temB then
    begin
       WriteFile(fhandle,PChar(mSend.Text)^,Length(mSend.Text),lrc,nil);//5 lrc addre
    end
    else
    begin
       timer1.Enabled := false;
       ShowMessage('请打开串口后再发送数据');
    end;
    rceiver(sender);
end;
//*******************************************************************
//        stop
///*****************************************************************
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
    case ComboBox2.itemIndex of
    1:temDCB.dcb.StopBits:=ONESTOPBIT;
    2:temDCB.dcb.StopBits:=ONE5STOPBITS;
    3:temDCB.dcb.StopBits:=TWOSTOPBITS;
    END;
end;
//*******************************************************************
//        date  bit
///*****************************************************************
procedure TForm1.ComboBox5Change(Sender: TObject);
begin
     case ComboBox5.itemIndex of
      1:temDCB.dcb.ByteSize:=8;
      2:temDCB.dcb.ByteSize:=7;
      3:temDCB.dcb.ByteSize:=6;
      end;
end;
//*******************************************************************
//        自动发送
///*****************************************************************
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
   Timer1.Enabled := false; //close
   try
     timer1.Interval  := strToInt(edit1.Text);
   except
     showmessage('input Error'); //弹出
     exit;
   end;
   timer1.Enabled := checkBox3.Checked; //激活
end;
//*******************************************************************
//        发送周期
///*****************************************************************
procedure TForm1.Timer1Timer(Sender: TObject);
begin
     BitBtn4Click(sender);
end;

end.