MSComm控件使用

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, StdCtrls, OleCtrls, MSCommLib_TLB, Math;

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function  HexToStr(mHex : string) : string;
    function Hex2ASCII(S: String):String;
    Function HexToDec(S:String):string;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
      MSComm1.PortOpen := True;
  except
      ShowMessage('打開串口失敗');
  end;
end;

procedure TForm1.MSComm1Comm(Sender: TObject);
var
  Redata : array of Variant;
  Restr, Restr2 : string;
  I : Integer;
begin
  Redata := MSComm1.Input;
  Restr:='';
  for I := 0 to VarArrayHighBound(Redata,1) do
  begin
      Restr := Restr + IntToHex(Redata[I],2);
      Restr2 := Restr2 + IntToHex(Redata[I],2) + ' ';
  end;
  Memo1.Lines.Add(Hex2ASCII(Restr) + #13);
  Memo2.Lines.Add(Restr2 + #13);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MSComm1.CommPort := 3;
  mscomm1.InputMode := comInputModeBinary;  //接收模式
  MSComm1.RThreshold := 15;               //设置接收多少字节开产生oncomm事件
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  try
      MSComm1.PortOpen := False;
  except
      ShowMessage('關閉串口失敗');
  end;
end;

function TForm1.HexToStr(mHex: string): string;
var  
  I : Integer;
begin
  Result := '';
  for I := 1 to Length(mHex) do
      Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));  
end;

function TForm1.Hex2ASCII(S: String): String;
var
  Str :String;
begin
  Str := '';

  while Length(S)>0 do
  begin
      if copy(S,1,2) <> '' then
          Str := Str + Chr(StrToInt(HexToDec(copy(S,1,2))))
      else
          Str := Str + copy(S,1,2);
     S := copy(S,3,Length(S));
  end;
  if UpperCase(Copy(Str,1,1)) = 'S' then
      Str := Trim(Copy(Str,2,Length(Str) - 1));
  Result := Trim(Str);
end;

function TForm1.HexToDec(S: String): string;
var
  A: array of string;
  i: integer;
  J: Variant;
begin
  SetLength(A,Length(s));
  j := 0;
  begin
     for i := Length(s) downto 1 do
     begin
         case S[i] of
           'A','a' : A[i-1]:='10';
           'B','b' : A[i-1]:='11';
           'C','c' : A[i-1]:='12';
           'D','d' : A[i-1]:='13';
           'E','e' : A[i-1]:='14';
           'F','f' : A[i-1]:='15';
         else
           A[i-1] := S[i];
         end;
         J := J + StrToInt(A[i-1])* IntPower(16,Length(S)-I);
     end;
  end;
  Result := J;
end;

end.