中国开发网: 论坛: 程序员情感CBD: 贴子 278002
HGRhgr: 这是示例代码:
unit ComMainForm1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, CPort, CPortCtl;

type
type
THGRBossPos = Class(TComponent)
private
FSTX : byte; //报文起始
FETX : byte; //报文结束
FLEN : array[0..1] of byte ; //报文正文長度,其中Len[1]表示正文長度除以256后取整,LEN[2]表示正文長度除以256后取模
FLRC : byte; //报文检验和,算法为从报文的起始到结束接位异或.
FCONTENT : string;
procedure SetContent(Value:string);
function GetActualContent():string;
public
constructor Create(Owner: TComponent); override;
property Content : string read FCONTENT write SetContent;
property ActualContent : string read GetActualContent;
end;

TForm1 = class(TForm)
ComPort: TComPort;
Memo: TMemo;
Button_Open: TButton;
Button_Settings: TButton;
Edit_Data: TEdit;
Button_Send: TButton;
Panel1: TPanel;
Bt_Store: TButton;
Bt_Load: TButton;
ComLed1: TComLed;
ComLed2: TComLed;
ComLed3: TComLed;
ComLed4: TComLed;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
ComLed5: TComLed;
ComLed6: TComLed;
Label1: TLabel;
Label6: TLabel;
procedure Button_OpenClick(Sender: TObject);
procedure Button_SettingsClick(Sender: TObject);
procedure Button_SendClick(Sender: TObject);
procedure ComPortOpen(Sender: TObject);
procedure ComPortClose(Sender: TObject);
procedure ComPortRxChar(Sender: TObject; Count: Integer);
procedure Bt_LoadClick(Sender: TObject);
procedure Bt_StoreClick(Sender: TObject);
procedure ComPortCTSChange(Sender: TObject; OnOff: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


{$R *.DFM}

{ THGRBossPos }

constructor THGRBossPos.Create(Owner: TComponent);
begin
inherited;
FSTX := $02;
FETX := $03;
inherited Create(Owner);
end;

function THGRBossPos.GetActualContent: string;
begin
Result:=Char(FSTX)+Char(FLEN[0])+Char(FLEN[1])+FCONTENT+Char(FETX)+Char(FLRC);
end;

procedure THGRBossPos.SetContent(Value: string);
var
i : integer;
begin
if Value<>FCONTENT then
begin
FCONTENT := Value;
FLEN[0] := Length(Value) div 256;
FLEN[1] := Length(Value) mod 256;
FLRC := FSTX xor FSTX;
FLRC := FLRC xor FLEN[0];
FLRC := FLRC xor FLEN[1];
for i:=1 to Length(Value) do
begin
FLRC := FLRC xor Byte(Value[i]);
end;
FLRC := FLRC xor FETX;
end;
end;


procedure TForm1.Button_OpenClick(Sender: TObject);
begin
if ComPort.Connected then
ComPort.Close
else
ComPort.Open;
end;

procedure TForm1.Button_SettingsClick(Sender: TObject);
begin
ComPort.ShowSetupDialog;
end;


procedure TForm1.Button_SendClick(Sender: TObject);
var
HGRBossPos:THGRBossPos;
PAsync1 : PAsync;
S:string;
begin
HGRBossPos := THGRBossPos.Create(nil);
HGRBossPos.Content := Edit_Data.Text;
// ComPort.WriteStr(HGRBossPos.ActualContent);
InitAsync(PAsync1);
try
ComPort.WriteStrAsync(HGRBossPos.ActualContent,PAsync1);
ComPort.WaitForAsync(PAsync1);

finally
DoneAsync(PAsync1);
end;

end;


procedure TForm1.ComPortOpen(Sender: TObject);
begin
Button_Open.Caption := 'Close';
end;

procedure TForm1.ComPortClose(Sender: TObject);
begin
if Button_Open <> nil then
Button_Open.Caption := 'Open';
end;


procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
Str: String;
begin

ComPort.ReadStr(Str, ComPort.InputCount);
Str := Trim(Str);
Memo.Lines.Add(Str);
{ if Pos('A',Str[1])=0 then
begin
ShowMessage('接收成功');
end
else if Pos('E',Str[1])=0 then
begin
ShowMessage('接收失败');
end; }

end;

procedure TForm1.Bt_LoadClick(Sender: TObject);
begin
ComPort.LoadSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\HGR');
// ComPort.LoadSettings(stIniFile, 'e:\Test.ini');
end;

procedure TForm1.Bt_StoreClick(Sender: TObject);
begin
// ComPort.StoreSettings(stIniFile, 'e:\Test.ini');
ComPort.StoreSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\HGR');
end;

procedure TForm1.ComPortCTSChange(Sender: TObject; OnOff: Boolean);
begin
Showmessage('ComPortCTSChange');
end;

end.

相关信息:


欢迎光临本社区,您还没有登录,不能发贴子。请在 这里登录