1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
| unit PgPrinc;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, IniFiles, Synaser;
type
{ TForm1 }
TForm1 = class(TForm)
AuDessus: TCheckBox;
NomPort: TComboBox;
Effacer: TButton;
Envoyer: TButton;
Emission: TEdit;
Quitter: TBitBtn;
Connecter: TButton;
Deconnecter: TButton;
ChoixBauds: TComboBox;
Label2: TLabel;
Label3: TLabel;
Label1: TLabel;
MemoData: TMemo;
procedure AuDessusClick(Sender: TObject);
procedure ChoixBaudsCloseUp(Sender: TObject);
procedure ConnecterClick(Sender: TObject);
procedure DeconnecterClick(Sender: TObject);
procedure EffacerClick(Sender: TObject);
procedure EnvoyerClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure QuitterClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
PortCOM: TBlockSerial;
ListeCOM: string;
InfoCOM: string;
Stop: boolean;
NbBauds: integer;
FchIni: TIniFile;
procedure OnDistoXStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
FchIni := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
with FchIni do {Récupération des valeurs enregistrées dans le fichier INI}
begin
NomPort.Text := ReadString('PrmCOM', 'Port', 'COM1');
ChoixBauds.ItemIndex := ReadInteger('PrmCOM', 'NbBauds', 1);
end;
NomPort.Items.CommaText:= GetSerialPortNames;
AuDessusClick(Sender);
end;
procedure TForm1.QuitterClick(Sender: TObject);
begin
DeconnecterClick(Sender);
end;
procedure TForm1.ConnecterClick(Sender: TObject);
begin
if Assigned(PortCOM) then
PortCOM.Free;
Stop := False;
PortCOM := TBlockSerial.Create;
PortCOM.OnStatus:= @OnDistoXStatus;
NbBauds := StrToInt(ChoixBauds.Items[ChoixBauds.ItemIndex]);
try
// MemoData.Lines.Add(PortCOM.ATCommand('AT+CPAS'));
PortCOM.Connect(NomPort.Items[NomPort.ItemIndex]);
PortCOM.Config(NbBauds, 8, 'N', 1, False, False);
while not Stop do
begin
try
InfoCOM := PortCOM.Recvstring(2000);
if InfoCOM <> '' then
MemoData.Lines.Add(InfoCOM);
Application.ProcessMessages;
except
end;
end;
finally
DeconnecterClick(Sender);
end;
end;
procedure TForm1.DeconnecterClick(Sender: TObject);
begin
Stop := True;
if Assigned(PortCOM) then
FreeAndNil(PortCOM);
end;
procedure TForm1.EffacerClick(Sender: TObject);
begin
MemoData.Clear;
end;
procedure TForm1.EnvoyerClick(Sender: TObject);
begin
if Emission.Text <> '' then
PortCOM.SendString(Emission.Text);
end;
procedure TForm1.ChoixBaudsCloseUp(Sender: TObject);
begin
NbBauds := StrToInt(ChoixBauds.Items[ChoixBauds.ItemIndex]);
end;
procedure TForm1.AuDessusClick(Sender: TObject);
begin
if AuDessus.Checked then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
DeconnecterClick(Sender);
with FchIni do
begin
WriteString('PrmCOM', 'Port', NomPort.Text);
WriteInteger('PrmCOM', 'NbBauds', ChoixBauds.ItemIndex);
end;
end;
procedure TForm1.OnDistoXStatus(Sender: TObject; Reason: THookSerialReason; const Value: string);
var
MyOP: byte;
begin
// ShowMessage(Format('OnDistoXStatus appelé: Code: %d', [Ord(Reason)]));
case Reason of
HR_SerialClose:
begin
ShowMessage(Format('%s est fermé', [Value]));
end;
HR_Connect:
begin
ShowMessage(Format('%s est ouvert', [Value]));
end;
HR_CanRead:
begin
ShowMessage('HR_CanRead' + Value);
end;
HR_CanWrite:
begin
ShowMessage('HR_CanWrite' + Value);
end;
HR_ReadCount:
begin
ShowMessage('HR_ReadCount' + Value);
end;
HR_WriteCount:
begin
ShowMessage('HR_WriteCount' + Value);
end;
HR_Wait:
begin
ShowMessage('HR_Wait' + Value);
end;
else
ShowMessage('HR_Unknown' + Value);
end;
//Application.ProcessMessages;
end;
end. |
Partager