kpv19820
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
unit ComMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, CPort, CPortCtl;
type
TForm1 = class(TForm)
ComPort: TComPort;
Memo: TMemo;
Button_Open: TButton;
Button_Settings: TButton;
Edit_Data: TEdit;
Button_Send: TButton;
NewLine_CB: TCheckBox;
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;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
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 Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Buf: array[1..1024] of ansichar;
i,ReadBytes: integer;
str, s1, s: string;
FileDir:String;
st: TstringList;
implementation
{$R *.DFM}
function StringToHex(s: string): string;
var
i: integer;
begin
result := '';
for i := 1 to Length(s) do
result := result + IntToHex(ord(s[i]), 2);
end;
function HexToString(s: string): string;
var
i: integer;
begin
result := '';
for i := 1 to Length(s) div 2 do
try result := result + chr(StrToInt('$' + copy(s, i*2-1, 2)));
except result := result + '?'; end;
end;
procedure TForm1.Button_OpenClick(Sender: TObject);
begin
if ComPort.Connected then
ComPort.Close
else
ComPort.Open;
with ComPort do
begin
timeouts.ReadInterval:=50;
timeouts.ReadTotalMultiplier:=70;
timeouts.ReadTotalConstant:=100;
timeouts.WriteTotalMultiplier:=60;
timeouts.WriteTotalConstant:=100;
// ComPort.BaudRate:=br11500;
end;
end;
procedure TForm1.Button_SettingsClick(Sender: TObject);
begin
ComPort.ShowSetupDialog;
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 SaveToFile(str:string;FileDir:String);
var
f:TextFile;
// FileDir:String;
begin
// FileDir:='c:\log.txt';
AssignFile(f,FileDir);
if not FileExists(FileDir) then
begin
Rewrite(f);
CloseFile(f);
end;
Append(f);
Write(f,str);
Flush(f);
CloseFile(f);
end;
procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
begin
ReadBytes := ComPort.Read(Buf, Count);
if ReadBytes < 0 then
ShowMessage('Ошибка чтения из COM-порта')
else
begin
for i := 1 to ReadBytes do
begin
if (IntToHex(Ord(Buf[i]),2)<>'0B') then
begin
if (IntToHex(Ord(Buf[i]),2)<>'1C') then s1:=s1 + Buf[i];
end;
end;
//ShowMessage(s);
end;
if (IntToHex(Ord(Buf[ReadBytes-1]),2)='1C') then
begin
st := TStringList.Create;
try
st.Delimiter := #13;
st.StrictDelimiter := True;
st.DelimitedText := s1;
i:=0;
for i := 0 to st.Count-2 do
begin
Memo.Text := Memo.Text + st[i]+#13#10;
FileDir:='c:\log.txt';
SaveToFile(st[i],FileDir);
end;
finally
st.Free;
end;
s1:='';
s:='';
i:=0;
end;
end;
procedure TForm1.Bt_LoadClick(Sender: TObject);
begin
ComPort.LoadSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\Dejan');
// 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\Dejan');
end;
end.
|
Всего записей: 55 | Зарегистр. 07-12-2007 | Отправлено: 15:02 17-11-2017 | Исправлено: kpv19820, 15:03 17-11-2017 |
|
