com.pas

老外自编串口组件及串口程序: Commu, a testform to check if everything is working correctly. XON/XOFF check is no

unit Com;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,MyCom, ExtCtrls;

type
  TForm1 = class(TForm)
    Info: TButton;
    GroupBox1: TGroupBox;
    CBBaud: TComboBox;
    Label1: TLabel;
    CBPort: TComboBox;
    Label2: TLabel;
    CBDataBit: TComboBox;
    CBParitet: TComboBox;
    CBstopbit: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Opret: TButton;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    BSend: TButton;
    BHent: TButton;
    Timer1: TTimer;
    BeskedBox: TMemo;
    GroupBox3: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    GroupBox4: TGroupBox;
    ComboBox1: TComboBox;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    SaveDialog1: TSaveDialog;
    GroupBox5: TGroupBox;
    EByte: TEdit;
    Bytebox: TListBox;
    Button10: TButton;
    Button11: TButton;
    Label6: TLabel;
    CBFlow: TComboBox;
    Xon: TEdit;
    Xoff: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Comm: TComm;
    procedure OpretClick(Sender: TObject);
    procedure BSendClick(Sender: TObject);
    procedure BHentClick(Sender: TObject);
    procedure InfoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
const
  second : boolean=false;

procedure TForm1.OpretClick(Sender: TObject);

var
  Fpar : integer;
  FStop : Integer;
  i : integer;

begin
  Second:=true;
  with comm do
  begin
    Parity:=tparitet(CBParitet.itemindex);
    Stopbits:=tStopbits(CBstopbit.itemindex);
    DataBits:=tDatabit(CBDatabit.itemindex+4);
    FlowControl:=tFlowcontrol (CBFlow.itemindex);
    Baud:=TBaud(cbBaud.itemindex+2);
    Port:=TPort(CbPort.ItemIndex);
    XON:=Char(StrToInt(self.XON.Text));
    XOFF:=Char(StrToInt(Self.XOFF.Text));
    connect;
  end;  
end;


procedure TForm1.BSendClick(Sender: TObject);
begin
  if second then {ER comm initialiseret?}
  with comm do
  begin
    SendString (Edit1.text);
  end;
end;

procedure TForm1.BHentClick(Sender: TObject);
begin
  if second then {ER comm initialiseret?}
  with comm do
  begin
    if InQue>0 then
      BeskedBox.lines.add (GetString(InQue));
  end;
end;

procedure TForm1.InfoClick(Sender: TObject);
begin
  If second then
    Form1.Caption:='Ind: '+IntToStr(Comm.InQue)+
                   ' Ud: '+IntToStr (Comm.OutQue);

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  If second then
  with comm do
  begin
    Form1.Caption:='Ind: '+IntToStr(InQue)+
                   ' Ud: '+IntToStr (OutQue)+
                   ' Fejl:'+IntToStr (Error)+
                   ' Flag:'+GetFlags;;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if second then
  with comm do
     SetEscCode (SETDTR);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if second then
  with comm do
    SetEscCode (SETRTS);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if second then
  with comm do
    SetEscCode (SETXON);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if second then
  with comm do
    SetEscCode (CLRDTR);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  if second then
  with comm do
    SetEscCode (CLRRTS);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  if second then
  with comm do
    SetEscCode (SETXOFF);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
 myc : integer;
 i : integer;

begin
  if second then
  with comm do
  begin
    For i:=0 to Cbparitet.items.count-1 do
      if combobox1.items[i]=combobox1.text then MyC:=i;
    case myc of
      0: SetEvent (EV_CTS);
      1: SetEvent (EV_DSR);
      2: SetEvent (EV_ERR);
      3: SetEvent (EV_RING);
      4: SetEvent (EV_RLSD);
    end;
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);

var
  ev : integer;

begin
  ComboBox1.Text:='';
  if second then
  with comm do
  begin
    GetEvent (ev);
    If (ev and ev_Cts)>0 then
      Combobox1.Text:=Combobox1.Text+'[EV_CTS]';
    If (ev and ev_DSR)>0 then
      Combobox1.Text:=Combobox1.Text+'[EV_DSR]';
    If (ev and ev_ERR)>0 then
      Combobox1.Text:=Combobox1.Text+'[EV_ERR]';
    If (ev and ev_RING)>0 then
      Combobox1.Text:=Combobox1.Text+'[EV_RING]';
    If (ev and ev_RLSD)>0 then
      Combobox1.Text:=Combobox1.Text+'[EV_RLSD]';
  end;
end;

procedure TForm1.Button9Click(Sender: TObject);

var
  fil : textfile;
  str : string;

begin
  if second then
  with comm do
  begin
    if (inque>0) and (Savedialog1.execute) then
    begin
      Str:=GetString(InQue);
      System.assign (fil,savedialog1.filename);
      Rewrite (fil);
      write (fil,str);
      closefile (fil);
    end;
  end;

end;

procedure TForm1.Button11Click(Sender: TObject);

var
  a : byte;
begin
  if second then
  with comm do
  begin
    a:=GetByte;
    Bytebox.items.add (intToStr (a));
  end;
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
  if second then
  with comm do
  begin
    Sendbyte(StrToInt(Ebyte.text));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CBPort.Itemindex:=0;
  CBFlow.ItemIndex:=0;
  CBBaud.ItemIndex:=3;
  CBStopbit.Itemindex:=0;
  CBDatabit.Itemindex:=4;
  CBparitet.Itemindex:=0;
end;

end.