ucomtest.pas

SPCOMM和ApdcomPort串口控件的使用

unit UComtest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, OoMisc, AdStatLt, AdPort, ADTrmEmu,
  AdPacket, SPComm;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    MemoGet: TMemo;
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    CmbCOM: TComboBox;
    CmbBoud: TComboBox;
    CmbParity: TComboBox;
    CmbDataBit: TComboBox;
    CmbStopBit: TComboBox;
    ApdStatusLight1: TApdStatusLight;
    Button1: TButton;
    Panel4: TPanel;
    Button2: TButton;
    Panel5: TPanel;
    MemoSend: TMemo;
    BtnSend: TButton;
    ChkHex: TCheckBox;
    ChkAuto: TCheckBox;
    Edit1: TEdit;
    Label6: TLabel;
    Edit2: TEdit;
    Label7: TLabel;
    ApdComPort1: TApdComPort;
    Button3: TButton;
    Button4: TButton;
    Edit3: TEdit;
    CheckBox1: TCheckBox;
    ChkHexShow: TCheckBox;
    Comm1: TComm;
    RadioGroup1: TRadioGroup;
    Button5: TButton;
    procedure ApdComPort1TriggerAvail(CP: TObject; Count: Word);
    procedure Button1Click(Sender: TObject);
    procedure BtnSendClick(Sender: TObject);
    procedure Dealbuf(const Bufs: array of byte; const Len: Word);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ApdDataPacket1StringPacket(Sender: TObject; Data: string);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Button5Click(Sender: TObject);
   private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
  I: Word;
  C: Char;
  S: string;
  Sshow: string;
begin
  S := '';
  for I := 1 to Count do begin
    C := ApdComPort1.GetChar;
   // case C of
  //    #0..#31: {Don't display};
   // else
    S := S + C;
   // end;
  end;
  if ChkHexShow.Checked then
  begin
    Sshow := '';
    for i := 1 to length(s) do
      Sshow := Sshow + inttohex(ord(S[i]), 2) + ' ';
    MemoGet.Lines.Add(Sshow);
  end
  else
    MemoGet.Lines.Add(S);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if RadioGroup1.ItemIndex = 0 then
  begin
    with ApdComPort1 do
    begin
      ComNumber := strtoint(copy(CmbCOM.Text, 4, length(CmbCOM.Text) - 3));
      Baud := strtoint(CmbBoud.Text);
      case CmbParity.ItemIndex of
        0: Parity := pNone;
        1: Parity := pOdd;
        2: Parity := pEven;
      else
        Parity := pNone;
      end;
      DataBits := strtoint(CmbDataBit.text);
      StopBits := strtoint(CmbStopBit.text);
      try
        Open := not ApdStatusLight1.Lit;
      finally
        ApdStatusLight1.Lit := not ApdStatusLight1.Lit;
      end;
    end;
  end
  else
  begin
    Comm1.CommName := CmbCom.Text;
    Comm1.StartComm;
    ApdStatusLight1.Lit := true;
  end;
  RadioGroup1.Enabled := false;
end;

procedure TForm1.BtnSendClick(Sender: TObject);
var
  Buf: array[0..1023] of byte;
  i, LenBuf: integer;
  tmpstr: string;
begin
  if ChkHex.Checked then
  begin
    tmpstr := StringReplace(Trim(memosend.Text), ' ', '', [rfReplaceAll]);
    LenBuf := 0;
    while length(tmpstr) >= 2 do
    begin
      Buf[LenBuf] := strtoint('$' + tmpstr[1] + tmpstr[2]);
      inc(LenBuf);
      Delete(tmpstr, 1, 2);
    end;
  end
  else
  begin
    tmpstr := trim(memosend.Text);
    LenBuf := Length(tmpstr);
    move(pchar(tmpstr)^,Buf[0],lenBuf);
  end;
  if RadioGroup1.ItemIndex = 0 then
    ApdComPort1.PutBlock(Buf, lenBuf)
  else
    comm1.writecommdata(@Buf, LenBuf);


 // Dealbuf(Buf, lenBuf);
end;

procedure TForm1.Dealbuf(const Bufs: array of byte; const Len: Word);
var
  I: Word;
  C: Char;
  S: string;
  Sshow: string;
begin
  S := '';
  for I := 0 to Len - 1 do begin
    C := chr(Bufs[i]);
    case C of
      #0..#31: {Don't display} S := S + C;
    else S := S + C;
    end;
  end;
  if ChkHexShow.Checked then
  begin
    Sshow := '';
    for i := 1 to length(s) do
      Sshow := Sshow + inttohex(ord(S[i]), 2) + ' ';
    MemoGet.Lines.Add(Sshow);
    MemoGet.SelLength := Length(MemoGet.Text);
    MemoGet.SelStart := 0;
  end
  else
  begin
    MemoGet.Lines.Add(S);
    MemoGet.SelLength := Length(MemoGet.Text);
    MemoGet.SelStart := 0;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  memoGet.Lines.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MemoSend.Clear;
end;

procedure TForm1.ApdDataPacket1StringPacket(Sender: TObject; Data: string);
begin
  memoGet.Text := Data;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  i: integer;
  Sshow: string;
  rbuf: array[0..1024] of byte;
begin
  move(Buffer^, rbuf, BufferLength);

  if ChkHexShow.Checked then
  begin
    Sshow := '';
    for i := 1 to bufferlength do
      Sshow := Sshow + inttohex(rbuf[i - 1], 2) + ' ';
    MemoGet.Lines.Add(Sshow);
  end
  else
  begin
    Sshow := '';
    for i := 1 to bufferlength do
      Sshow := Sshow + chr(rbuf[i - 1]);
    MemoGet.Lines.Add(Sshow);
  end;
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
  comm1.StopComm;
  if comm1.Handle <> 0 then
    showmessage('串口已经打开');
end;

end.