unit1.~pas

精彩的spcomm控件,字符传输或16进制传输,有简单的传输协议,非常典型的应用

//*********************************************************
//                 Kaersoft    卡尔软件
//         *************************************
//          http://www.kaer.cn/default.aspx
//          Email:[e-mail]
//          QQ:54076683
//          Delphi 7.0   PASS
//          调测人：JPYC
//**********************************************************
//                      程序功能
//            演示SPCOMM收发数据的例子
//**********************************************************
//实现思路：打开窗体时自动打开串口1，关闭是自动关闭串口
//**********************************************************
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Comm1: TComm;
    Memo1: TMemo;
    Memo2: TMemo;
    Button3: TButton;
    Button4: TButton;
    Check1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    LEDFontNum1: TLEDFontNum;
    LEDFontNum2: TLEDFontNum;
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SendHex(S: String);
    procedure Delay(MSecs: Longint);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure LEDFontNum1Click(Sender: TObject);
    procedure Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
var
a:integer;


{$R *.dfm}

procedure TForm1.Button4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.SendHex(S: String);
var
  s2:string;
  buf1:array[0..50000] of char;
  i:integer;
begin
  s2:='';
  for i:=1 to  length(s) do     //将非16进字符去掉
  begin
    if ((copy(s,i,1)>='0') and (copy(s,i,1)<='9'))or((copy(s,i,1)>='a') and (copy(s,i,1)<='f'))
        or((copy(s,i,1)>='A') and (copy(s,i,1)<='F')) then
    begin
        s2:=s2+copy(s,i,1);    //合成16进字符
    end;
  end;
  for i:=0 to (length(s2) div 2-1) do
    buf1[i]:=char(strtoint('$'+copy(s2,i*2+1,2)));  //取2位为1组发送
  Comm1.WriteCommData(buf1,(length(s2) div 2));
  memo1.Lines.Add(s2);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  p:pchar;
  x:integer;
begin
  if Check1.Checked then
    SendHex(Memo1.Lines.Text)   //发送十六进制
//     SendHex(self.Edit1.Text)
  else begin
    x:=Length(Memo1.Lines.Text);    //发送字符
    p:=Pchar(Memo1.Lines.Text);
    Comm1.WriteCommData(p,x);
  end;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
{            type   ss=array[1..500]of char ;
            var    str1:^ss;
                   i:integer;
                   s:array[0..15] of char ;
                   n:integer;
            begin
                   str1:=Buffer;
                 //s[]=('0','1','2','3'...'E')
                   for i:=0 to 9 do
                   s[i]:=chr(48+i);
                   for i:=10 to 15 do
                   s[i]:=chr(55+i);
                                   self.Memo2.Clear;
                   for i:=1 to bufferlength do
                   begin
                   n:=ord(str1^[i]);
                   Memo2.Lines.add(s[n div 16]+s[n mod 16]);
                   end;
            end; }

var
 tmpArray:array[0..4096] of Byte;
 i: DWORD;
 tmpStr:string;
 pStr:PChar;
begin
  if Check1.Checked  then
  begin
   pStr:=Buffer;
   tmpStr:=string(pStr);
   Dec(PStr);
                 self.Memo2.Clear;
   for i:=0 to Length(tmpStr)-1 do
    begin
     inc(PStr);
     tmpArray[i]:=Byte(PSTR^);
     Memo2.Lines.Add(IntToHEX(Ord(tmpArray[i]),2));
      if IntToHEX(Ord(tmpArray[i]),2)<>'55' then  //数码管显示结果
        begin
         self.LEDFontNum2.Text:='';
         self.LEDFontNum2.Text:=IntToHEX(Ord(tmpArray[i]),2);
        end; 
    end;
   exit;
  end;
  pStr:= Buffer;
  memo2.Lines.Add(pStr);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Comm1.StartComm;
   a:=0;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Comm1.StopComm;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 self.SendHex('aa');
 delay(10);
 self.SendHex('01');
 delay(10);
 self.SendHex('ff');
 delay(10);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 self.SendHex('aa');
 delay(10);
 self.SendHex('01');
 delay(10);
 if a>=16 then a:=0;
 self.SendHex(inttohex(ord(a),2));//inttostr(a));
 delay(10);
 self.LEDFontNum1.Text:=inttostr(a);//inttohex(ord(a),2);
 inc(a);
end;

procedure TForm1.LEDFontNum1Click(Sender: TObject);
begin
a:=0;
self.LEDFontNum1.Text:='00';
self.Button2.Click;
end;

procedure TForm1.Delay(MSecs: Longint); //延时函数，MSecs单位为毫秒(千分之1秒)
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
  Application.ProcessMessages;
  Now := GetTickCount();
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;


procedure TForm1.Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
begin
 showmessage('chucuola');
end;

end.