delphi用SPCOMM串口定时器间隔快速发送数据错误,求救

fuqiangzhang 2015-01-27 09:34:43
Delphi 控件SPCOMM发送数据,手动点击button,button事件连续发送数据到串口,下位机接收正常,下位机是Arduino2560, 同样的数据放到定时器里就不行,如果定时器时间设置1000ms,发送正常,800ms一下就不行,我希望能没间隔50ms就发送一次。
一下是测试程序的源码,哪位大侠给帮忙找找问题。测试了ComPort控件也是同样的问题。

unit SpCommTest;

interface

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

type
TForm1 = class(TForm)
cbbComName: TComboBox;
btn1: TButton;
edt1: TEdit;
Memo1: TMemo;
SPComm1: TComm;
MMTimer1: TMMTimer;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure SPComm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure MMTimer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var flag:boolean=false;
SendStr:string;
fin:boolean=false;

//此处用于自动获取系统的串口数目以及名称,调用api函数实现相关功能
procedure EnumComPorts(Ports: TStrings);
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
begin
ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE,'HARDWARE\DEVICEMAP\SERIALCOMM',0,KEY_READ,KeyHandle);
if ErrCode <> ERROR_SUCCESS then Exit; // raise EComPort.Create(CError_RegError, ErrCode);
TmpPorts := TStringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(KeyHandle,Index,PChar(ValueName),
Cardinal(ValueLen),nil,@ValueType,PByte(PChar(Data)),@DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Data);
Inc(Index);
end
else
if ErrCode <> ERROR_NO_MORE_ITEMS then
exit; //raise EComPort.Create(CError_RegError, ErrCode);
until (ErrCode <> ERROR_SUCCESS) ;
TmpPorts.Sort;
Ports.Assign(TmpPorts);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
end;
end;

function HexToStr( //十六进制字符串处理成字符串
mHex: string //十六进制字符串
): string; //返回处理后的字符串
var
I: Integer;
begin
Result := '';
mHex := StringReplace(mHex, #32, '', [rfReplaceAll]);
for I := 1 to Length(mHex) div 2 do
Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));
end; { HexToStr }

function StrToHex( //字符串处理成十六进制字符串
mStr: string; //字符串
//mSpace: Boolean = False //是否用空格分开
mSpace: Boolean = True //是否用空格分开
): string; //返回处理后的十六进制字符串
const
cSpaceStr: array[Boolean] of string = ('', #32);
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mStr) do
Result := Format('%s%s%.2x', [Result, cSpaceStr[mSpace], Ord(mStr[I])]);
if mSpace then Delete(Result, 1, 1);
end; { StrToHex }

function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
t:Integer;
ts:string;
M,Code:Integer;
begin
t:=1;
Result:='';
while t<=Length(S) do
begin //xlh 2006.10.21
while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
inc(t);
if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
ts:='$'+S[t]
else
ts:='$'+S[t]+S[t+1];
Val(ts,M,Code);
if Code=0 then
Result:=Result+Chr(M);
inc(t,2);
end;
end;

//发送字符串
procedure SendString;
var str:string;
begin
if sendstr='' then exit;
str:=SendStr+';';
form1.SPComm1.WriteCommData(pchar(str),Length(str));
end;



procedure TForm1.FormCreate(Sender: TObject);
var id:THandle;
begin
EnumComPorts(cbbComName.Items);
cbbComName.ItemIndex := 0;
if cbbComName.Text<>'' then
with SPComm1 do
begin
CommName := cbbComName.Text;
BaudRate:=115200;
ByteSize:=_8;
StopBits:=_1;
try
StartComm;
except
On Exception do;
end;
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var i:integer;
id:THandle;
begin
//SendStr:=edt1.text;
//CreateThread(nil, 0, @SendString, nil, 0, ID);
for i:=1 to 10 do
begin
SendStr:='1,255';
CreateThread(nil, 0, @SendString, nil, 0, ID);
sleep(50);
//SendStr:='1,0';
//CreateThread(nil, 0, @SendString, nil, 0, ID);
//sleep(10);
application.ProcessMessages;
end;
end;

procedure TForm1.SPComm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
viewstring:string;
begin //-------------接受返回信息-----------
setlength(viewstring,bufferlength);
move(buffer^,pchar(viewstring)^,bufferlength);
memo1.Lines.clear;
memo1.Lines.add(viewstring);
Memo1.Invalidate;
end;

procedure TForm1.MMTimer1Timer(Sender: TObject);
begin
SendStr:='1,255';
SendString;
end;

end.
...全文
484 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

2,641

社区成员

发帖
与我相关
我的任务
社区描述
VC/MFC 硬件/系统
社区管理员
  • 硬件/系统社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧