曾经用Delphi写的一个上位机_工匠梦想

http://blog.sina.com.cn/u/1246565342

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

曾经用Delphi写的一个上位机

(2013-02-17 18:15:47)

标签：

上位机

spcomm

delphi

串口通信

智能小车

校园

分类：机械电子

http://s12/mw690/4a4d13degd5e8eb95d90b&690

基于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;

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;

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;

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.

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：读取GPS数据源程序及资料

后一篇：你没见过的拖车

新浪BLOG意见反馈留言板　欢迎批评指正