曾经用Delphi写的一个上位机

基于SPCOMM控件。

源码：

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, SPComm, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Comm1: TComm;

    GroupBox1: TGroupBox;

    go: TButton;

    left: TButton;

    right: TButton;

    back: TButton;

    left30: TButton;

    right30: TButton;

    yuan90: TButton;

    yuan360: TButton;

    GroupBox2: TGroupBox;

    Label5: TLabel;

    Label6: TLabel;

    Label7: TLabel;

    Memo4: TMemo;

    Memo5: TMemo;

    Memo6: TMemo;

    GroupBox3: TGroupBox;

    opencom: TButton;

    lianjie: TButton;

    xinxi: TMemo;

    procedure SendHex(S: String);

    procedure left30Click(Sender: TObject);

    procedure opencomClick(Sender: TObject);

    procedure goClick(Sender: TObject);

    procedure backClick(Sender: TObject);

    procedure CommReceiveData(Sender: TObject; Buffer: Pointer;

  BufferLength: Word);

    procedure leftClick(Sender: TObject);

    procedure rightClick(Sender: TObject);

    procedure w(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

    procedure FormKeyUp(Sender: TObject; var Key: Word;

      Shift: TShiftState);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  BUF: string;

 

 

implementation

 

{$R *.dfm}

function StrToHex(mStr:String;stlen:word):string;

var

    I:Integer;

begin

    Result:='';

    for I := 1 to stlen do

    begin

        if mstr[i]=#0 then

            Result:=Result+'00 '

        else

         Result:=Result+IntToHex(Ord(mStr[I]),2)+' ';

    end;

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

  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);

    end;

  end;

  for i:=0 to (length(s2) div 2-1) do

    buf1[i]:=char(strtoint('$'+copy(s2,i*2+1,2)));

  Comm1.WriteCommData(buf1,(length(s2) div 2));

 

end;

 

procedure TForm1.left30Click(Sender: TObject);

begin

  SendHex('aa');   //发送十六进制

end;

 

 

 

procedure TForm1.opencomClick(Sender: TObject);

 

begin

  buf:='0';

   SendHex(buf);

if opencom.Caption = '打开端口' then

  begin

  Comm1.StartComm;

 

  opencom.Caption := '关闭端口';

  end

else //if Button1.Caption = '关闭串口' then

  begin

  Comm1.StopComm;

  opencom.Caption := '打开端口';

  end;

end;

 

procedure TForm1.goClick(Sender: TObject);

begin

  buf:='11';

  SendHex(buf);

end;

 

procedure TForm1.backClick(Sender: TObject);

begin

  buf:='12';

  SendHex(buf);

end;

 

procedure TForm1.leftClick(Sender: TObject);

begin

  buf:='14';

  SendHex(buf);

end;

 

procedure TForm1.rightClick(Sender: TObject);

begin

  buf:='13';

  SendHex(buf);

end;

 

procedure Tform1.CommReceiveData(Sender: TObject; Buffer: Pointer;

  BufferLength: Word);

var

  strRecv : string;

begin

  setLength(strRecv,BufferLength);

  Move(Buffer^,pchar(strRecv)^,BufferLength);

  xinxi.Lines.Add('已收到：'+intTostr(BufferLength)+'字节的数据');

  xinxi.Lines.Add(strRecv);

  xinxi.Invalidate ;

end;

 

 

 

procedure TForm1.w(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

  buf:='11';

  SendHex(buf);

end;

 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key=87 then

     buf:='11';

      SendHex(buf);

  if Key=83 then

     buf:='12';

     SendHex(buf);

  if Key=68 then

     buf:='13';

     SendHex(buf);

  if Key=65 then

    buf:='14';

     SendHex(buf);

 

 

 

end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

    if Key=87 then

      SendHex('ff');

    if Key=65 then

      SendHex('ff');

   if Key=68 then

       SendHex('ff');

   if Key=83 then

      SendHex('ff');

end;

 

end.