曾经用Delphi写的一个上位机
2015-08-30 08:01
453 查看
基于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.
源码:
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.
相关文章推荐
- 使用SetWindowPos API函数移动窗口后,还需修改Delphi的属性值,以备下次使用,否则就会出问题(不是API不起作用,而是使用了错误的坐标值)
- Delphi调用WINAPI时到底应该是指针还是结构体(注意是Delphi变量本身就是指针)
- Delphi的字符串与16进制的相互转换函数的汇编代码
- delphi的取整函数round、trunc、ceil和floor
- Delphi判断文件是否正在被使用(CreateFile也可以只是为了读取数据,而不是创建)
- Delphi 的运算符列表,运算符及优先级表格 good
- Delphi编程中资源文件的应用
- Delphi 指针大全(光看不练是学不会的)
- delphi编程里的bool跟boolean类型有什么区别
- * Delphi编程时候诡异地出现ORA-00937错误,记录解决它的思路和方法
- python4delphi import lxml pandas 出错的小结
- Delphi 和 DFM
- win8(x64)下,重新安装delphi 2007时出现“Invalid Serial Number”,如何解决?
- delphi中文件以及线程操作基础
- [备忘]Delphi 7 编译软件申请管理员权限
- Delphi 在多线程中会应用到的读写锁-“多读一写”同步器-TMultiReadExclusiveWriteSynchronizer
- (转载)Delphi TStringList的用法
- Delphi 连接SQLserver
- Delphi 7连接MySql 5.5.15
- python4delphi 设置syspath