unit1.pas

Delphi7高级应用开发配书源代码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Comm1: TComm;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    RadioGroup1: TRadioGroup;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    CB_BaudRate: TComboBox;
    Label3: TLabel;
    CB_ParityCheck: TComboBox;
    BitBtn1: TBitBtn;
    Label2: TLabel;
    CB_ParityValue: TComboBox;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    Shape1: TShape;
    Button4: TButton;
    Label5: TLabel;
    Shape2: TShape;
    Button5: TButton;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
	if RadioGroup1.ItemIndex=0 then
  	Comm1.CommName:='COM1'
  else
  	Comm1.CommName:='COM2';
	Comm1.StartComm;
  Label7.Caption:='串口已经打开，可以测试';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
	Comm1.StopComm;
  Label7.Caption:='串口尚未打开';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	Comm1.StopComm;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	Comm1.WriteCommData(Pchar(Memo1.Text),Length(Memo1.Text));
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  ReceivedString:String;
begin
	SetLength(ReceivedString,Bufferlength);
	Move(Buffer^,PChar(ReceivedString)^,BufferLength);
	Memo2.Text:=ReceivedString;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
	case CB_BaudRate.ItemIndex of
  	0:   Comm1.BaudRate:=9600;
    1:   Comm1.BaudRate:=4800;
    2:   Comm1.BaudRate:=2400;
    3:   Comm1.BaudRate:=1200;
  end;

  if CB_ParityCheck.ItemIndex=0 then
  	Comm1.ParityCheck:=false
  else
  	Comm1.ParityCheck:=True;

  if CB_ParityValue.ItemIndex=0 then
  	Comm1.Parity:=Mark
  else
  	Comm1.Parity:=None;  

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
	if Comm1.DtrControl=DtrEnable then
  	begin
    Comm1.DtrControl:=DtrDisable;
    Shape1.Brush.Color:=clWhite;
    end
  else
  	begin
    Comm1.DtrControl:=DtrEnable;
    Shape1.Brush.Color:=clRed;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
	if Comm1.DtrControl=DtrEnable then
  	Shape1.Brush.Color:=clRed;

 	if Comm1.RtsControl=RtsEnable then
  	Shape2.Brush.Color:=clRed;

  Label7.Caption:='串口尚未打开';
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
	if Comm1.RtsControl=RtsEnable then
  	begin
    Comm1.RtsControl:=RtsDisable;
    Shape2.Brush.Color:=clWhite;
    end
  else
  	begin
    Comm1.RtsControl:=RtsEnable;
    Shape2.Brush.Color:=clRed;
    end;
end;

end.