Création de thread

Version imprimable

Création de thread

bonjour a tous !!

bon voila je vous explique rapidement mon soucis, j'ai réalisé une application (merci parhelie d'ailleur) permettant de connecter, configurer et receptionner les trames d'un port série.
voila le code:

Code:

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
 
 
unit UnitMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, synaser, ExtCtrls,Windows;
 
type
 
  { TFrmMain }
 
  TFrmMain = class(TForm)
    BtnDetectionPort: TButton;
    BTOuvrir: TButton;
    BTFermer: TButton;
    cbChoixPort: TComboBox;
    cbVitessedetransfert: TComboBox;
    cbBitsdedonnees: TComboBox;
    cbParite: TComboBox;
    cbBitdarret: TComboBox;
    chkHardflow: TCheckBox;
    chkSoftflow: TCheckBox;
    DPS: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MemoMain: TMemo;
    procedure BTFermerClick(Sender: TObject);
    procedure BtnDetectionPortClick(Sender: TObject);
    procedure BTOuvrirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
     private
    { private declarations }
  public
    { public declarations }
    procedure DetectPortCOM;
  end; 
 
var
  FrmMain: TFrmMain;
  ser:TBlockSerial;
  stop : boolean;
 
implementation
 
{ TFrmMain }
 
//Etape 1 Détection du port COM
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  //----- creation du port
  ser := TBlockSerial.Create;
  DetectPortCom;
end;
 
procedure TFrmMain.BtnDetectionPortClick(Sender: TObject);
begin
DetectPortCOm;
end;
 
  // ----- détection des port COM linux Win32
 
procedure TFrmMain.DetectPortCOM;
var
  l: string;
  p: integer;
 
begin
     cbChoixPort.Clear;
 
{$IFDEF WIN32}
      l := GetSerialPortNames;
 
     if l >'' then repeat
       begin
          p :=  pos(',',l);
          if p > 0 then
            begin
              cbChoixPort.Items.Add(copy(L,1,p-1));
              delete(L,1,p);
            end
          else
            cbChoixPort.Items.Add(L);
        end;
      until p = 0;
{$ENDIF}
{$ifdef linux}
 If FileExists('/dev/ttyUSB0') then cbChoixPort.Items.Add('/dev/ttyUSB0');
 If FileExists('/dev/ttyUSB1') then cbChoixPort.Items.Add('/dev/ttyUSB1');
{$ENDIF}
end;
 
//Etape 2 Configuration du port COM
 
procedure TFrmMain.BTOuvrirClick(Sender: TObject);
var
  port : string;
  bauds, databit, stopbit: integer;
  parity : char;
  hardflow, softflow : boolean;
 
begin
  // ----- évite la modification de la configuration du port lors de son fonctionnement
  cbChoixPort.Enabled:=false;
  cbVitessedetransfert.Enabled:=false;
  cbBitsdedonnees.Enabled:=false;
  cbParite.Enabled:=false;
  cbBitdarret.Enabled:=false;
  chkHardflow.Enabled:=false;
  chkSoftflow.Enabled:=false;
  BTOuvrir.enabled:=false;
 
 
  //----- ouverture du port
  port := cbChoixPort.Items[cbChoixPort.itemIndex];
  ser.Connect(port);
  //ser.RaiseExcept:=true;
  //----- parametrage du port
  case cbVitessedeTransfert.itemindex of
       0 : bauds := 9600;
       1 : bauds := 19200;
       2 : bauds := 38400;
       3 : bauds := 57600;
       4 : bauds := 115200;
  end;
 
  case cbBitsdeDonnees.Itemindex of
       0 : databit := 4;
       1 : databit := 5;
       2 : databit := 6;
       3 : databit := 7;
       4 : databit := 8;
  end;
 
  case cbParite.Itemindex of
       0 : parity := 'N';
       1 : parity := 'O';
       2 : parity := 'E';
       3 : parity := 'M';
       4 : parity := 'S';
  end;
 
  case cbBitdarret.itemindex of
       0 : stopbit := SB1;
       1 : stopbit := SB1andHalf;
       2 : stopbit := SB2;
  end;
 
  softflow := chkSoftflow.checked;
  hardflow := chkHardflow.checked;
 
 
  ser.Config(bauds,databit,parity,stopbit,softflow,hardflow);
 
  // ----- Lancement de l'acquisition des trames
 
stop := false;
  repeat
     memomain.Lines.Add(ser.RecvTerminated(1000,#13#10));
     Application.ProcessMessages;
  until  stop = true;
end;
 
 
 
procedure TFrmMain.BTFermerClick(Sender: TObject);
begin
  // ----- permet la modification de la configuration du port, une fois fermer
  cbChoixPort.Enabled:=true;
  cbVitessedetransfert.Enabled:=true;
  cbBitsdedonnees.Enabled:=true;
  cbParite.Enabled:=true;
  cbBitdarret.Enabled:=true;
  chkHardflow.Enabled:=true;
  chkSoftflow.Enabled:=true;
  BTOuvrir.enabled:=true;
  // ----- fermeture du port COM
  stop := true;
  ser.CloseSocket;
end;
 
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  //libérer le port
  ser.CloseSocket;
  ser.Free;
end;
 
initialization
  {$I unitmain.lrs}
 
end.

le code marche parfaitement mais je voudrais juste remplacer la fonction repeat until qui forme une boucle permettant de receptionner les trames par un thread !!
donc voilà si quelqu'un pouvait m'expliquer comment je peut faire !!
j'ai déja était voir les pages concernant les thread sur le site mais je saisi pas tout, je débute en programmation !!

merci d'avance pour votre aide !!

16/03/2009, 12h19
darrylsite

Le meiux est de nous dire ce que tu ne comprend pas pour la mise en oeuvre des threads ou, ce qui te bloques.

Par exemple je trouve les explications données au lien suivant assez claires :
http://wiki.lazarus.freepascal.org/M...ation_Tutorial
16/03/2009, 12h32
showza

merci pour le lien !!

alors pour commencer est ce que j'ai besoin de rajouter un classe via l'inspecteur de projet !!

et est que je doit créer une nouvelle unit pour y mettre mon thread ou puis je l'insérer dans mon unit main ?
16/03/2009, 13h10
darrylsite

Je crois que c'est mieux de faire une unité à part pour ton thread, ceci pour la lisibilité et la maintenance du code. Mais tu peux toujours tout mettre ensemble si tu veux avoir un programme touffu.

Tiens nous au courant de la progression.
16/03/2009, 13h35
showza

ok je pense que je vais tout mettre ensemble si cela ne pose pas de problème car ensuite je ne me servirai plus du code j'utiliserai que les exécutables, et tu n'aurais pas des exemples un peu plus concret que ceux de ton lien ??
parce que je peine à comprendre sur les exemples données.

Je souhaite avoir un fonctionnement du genre j'appui sur ouvrir il me lance le thread qui me permet d'acquérir les trames et ensuite le bouton fermer arrête l'acquisition des trames.

salut darrylsite !

sur le lien que tu m'as donné, j'ai un petit problème avec la classe TThread quand je compile

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
  procedure TMyThread.Execute;
  var
    newStatus : string;
  begin
    fStatusText := 'TMyThread Starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and ([any condition required]) do
      begin
        ...
        [here goes the code of the main thread loop]
        ...
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;

voila l'erreur :
Fatal: Syntax error, "]" expected but "identifier CONDITION" found

17/03/2009, 12h16
parhelie

:D [any condition required] :D
17/03/2009, 12h34
showza

Citation:

:lol:[any condition required]:lol:

c'est à dire ?

le probleme vient evidemment de là. [any condition required] doit etre remplacer par une expression boolenne.
ça pourra te servir d'arreter la lecture des trames.
Si tu definis la classe comme suit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 type TMyThread = class(TThread) private lecture : boolean; public function getLectureState() : boolean; procedure stopLecture(); ... //le code du thread while (not Terminated) and (lecture) do begin // code à executer end; end;
Le thread sera arreter quand on va appeler la methode stopLecture() qui se contente de mettre lecture à false.

17/03/2009, 13h07
showza

Ok merci bien, dans mon cas le code à exécuter sera juste :

Code:

memomain.Lines.Add(ser.RecvTerminated(1000,#13#10));

voilà ce que j'ai fait pour l'instant :

unit main
pour rappel BTOUVRIR doit lancer le thread et BTFERMER doit arrêter le thread

Code:

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
 
unit UnitMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, synaser, ExtCtrls, unitthread;
 
type
 
  { TFrmMain }
 
  TFrmMain = class(TForm)
    BtnDetectionPort: TButton;
    BTOuvrir: TButton;
    BTFermer: TButton;
    cbChoixPort: TComboBox;
    cbVitessedetransfert: TComboBox;
    cbBitsdedonnees: TComboBox;
    cbParite: TComboBox;
    cbBitdarret: TComboBox;
    chkHardflow: TCheckBox;
    chkSoftflow: TCheckBox;
    DPS: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MemoMain: TMemo;
    procedure BTFermerClick(Sender: TObject);
    procedure BtnDetectionPortClick(Sender: TObject);
    procedure BTOuvrirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
     MyThread: TMyThread;
     procedure ShowStatus(Status: string);
  public
    { public declarations }
    procedure DetectPortCOM;
  end; 
 
var
  FrmMain: TFrmMain;
  ser:TBlockSerial;
 
implementation
 
{ TFrmMain }
 
//Etape 1 Détection du port COM
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  //----- creation du port
  ser := TBlockSerial.Create;
  DetectPortCom;
  inherited;
    MyThread := TMyThread.Create(true);
    MyThread.OnShowStatus := @ShowStatus;
 
end;
 
procedure TFrmMain.BtnDetectionPortClick(Sender: TObject);
begin
DetectPortCOm;
end;
 
  // ----- détection des port COM linux Win32
 
procedure TFrmMain.DetectPortCOM;
var
  l: string;
  p: integer;
 
begin
     cbChoixPort.Clear;
 
{$IFDEF WIN32}
      l := GetSerialPortNames;
 
     if l >'' then repeat
       begin
          p :=  pos(',',l);
          if p > 0 then
            begin
              cbChoixPort.Items.Add(copy(L,1,p-1));
              delete(L,1,p);
            end
          else
            cbChoixPort.Items.Add(L);
        end;
      until p = 0;
{$ENDIF}
{$ifdef linux}
 If FileExists('/dev/ttyUSB0') then cbChoixPort.Items.Add('/dev/ttyUSB0');
 If FileExists('/dev/ttyUSB1') then cbChoixPort.Items.Add('/dev/ttyUSB1');
{$ENDIF}
end;
 
//Etape 2 Configuration du port COM
 
procedure TFrmMain.BTOuvrirClick(Sender: TObject);
var
  port : string;
  bauds, databit, stopbit: integer;
  parity : char;
  hardflow, softflow : boolean;
 
begin
  // ----- évite la modification de la configuration du port lors de son fonctionnement
  cbChoixPort.Enabled:=false;
  cbVitessedetransfert.Enabled:=false;
  cbBitsdedonnees.Enabled:=false;
  cbParite.Enabled:=false;
  cbBitdarret.Enabled:=false;
  chkHardflow.Enabled:=false;
  chkSoftflow.Enabled:=false;
  BTOuvrir.enabled:=false;
 
 
  //----- ouverture du port
  port := cbChoixPort.Items[cbChoixPort.itemIndex];
  ser.Connect(port);
 
  //----- parametrage du port
  case cbVitessedeTransfert.itemindex of
       0 : bauds := 9600;
       1 : bauds := 19200;
       2 : bauds := 38400;
       3 : bauds := 57600;
       4 : bauds := 115200;
  end;
 
  case cbBitsdeDonnees.Itemindex of
       0 : databit := 4;
       1 : databit := 5;
       2 : databit := 6;
       3 : databit := 7;
       4 : databit := 8;
  end;
 
  case cbParite.Itemindex of
       0 : parity := 'N';
       1 : parity := 'O';
       2 : parity := 'E';
       3 : parity := 'M';
       4 : parity := 'S';
  end;
 
  case cbBitdarret.itemindex of
       0 : stopbit := SB1;
       1 : stopbit := SB1andHalf;
       2 : stopbit := SB2;
  end;
 
  softflow := chkSoftflow.checked;
  hardflow := chkHardflow.checked;
 
 
  ser.Config(bauds,databit,parity,stopbit,softflow,hardflow);
 
  // ----- Lancement de l'acquisition des trames
 
  MyThread.Resume;
end;
 
procedure TFrmMain.ShowStatus(Status: string);
   begin
   MemoMain.Caption := Status;
   end;
 
 
procedure TFrmMain.BTFermerClick(Sender: TObject);
begin
  // ----- permet la modification de la configuration du port, une fois fermer
  cbChoixPort.Enabled:=true;
  cbVitessedetransfert.Enabled:=true;
  cbBitsdedonnees.Enabled:=true;
  cbParite.Enabled:=true;
  cbBitdarret.Enabled:=true;
  chkHardflow.Enabled:=true;
  chkSoftflow.Enabled:=true;
  BTOuvrir.enabled:=true;
  // ----- fermeture du port COM
  ser.CloseSocket;
  ser.Free;
  // ----- fermer le thread
  MyThread.Terminate;
  //MyThread.Free;
  inherited;
end;
 
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  //libérer le port
  ser.CloseSocket;
  ser.Free;
end;
 
initialization
  {$I unitmain.lrs}
 
end.

unit thread
doit éxecuter l'acquisition des trames

unitThread

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, unitmain;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      MyThread: TMyThread;
      lecture : boolean;
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      //function getLectureState(): boolean;
      //procedure stopLecture();
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
 
 
implementation
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
 
procedure TMyThread.Execute;
  var
  newStatus : string;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
        //...
        //[code à exécuter]
        //...
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
 
initialization
 
 
end.

quand j'utilise le code memomain.lines.add(ser.RecvTerminated(1000,#13#10)); dans mon unit Thread il me met une erreur Identifier not found "memomain" alors que j'utilise bien unitmain.

C'est tout à fait normal puisque memomain est un attribut d'une classe de type TFrmMain.
Un moyen de regler ça est d'ajouter un attribut memomain dans la classe du thread, que tu initialisera par TFrmMain.memomain . Pour celà, tu crée une methode
Code:

1 2 3 4 5 procedure setMemo(Memo: TMemo) begin MemoMain:=memo; end;
dans la classe etendant le tthread. et appeler cette methode lors de l'initialisation du thread.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure TFrmMain.FormCreate(Sender: TObject); begin //----- creation du port ser := TBlockSerial.Create; DetectPortCom; inherited; MyThread := TMyThread.Create(true); MyThread.OnShowStatus := @ShowStatus; MyThread.setMemo(MemoMain); end;

j'ai fait la modification mais j'obtient une erreur: Identifier not Found "TMemo"

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, synaser;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      ser: TBlockSerial;
      MyThread: TMyThread;
      lecture : boolean;
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      //function getLectureState(): boolean;
      //procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
 
 
implementation
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
 
procedure TMyThread.Execute;
  var
  newStatus : string;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
        //...
        //[code à exécuter]
        MemoMain.lines.add(ser.RecvTerminated(1000,#13#10));
        //...
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
 
initialization
 
 
end.

et pour les procedures stopLecture et getLectureState je met juste respectivement lecture:=false; et lecture:=true;

je crois que c'est un probleme d'unité. Puisque tu l'as utilisé dans unitmain. Je ne sais de quelle unité il s'agit, mais tu peux facilement le savoir en essayant d'ajouter un à un les unité utilisées dans unitmain
Code:

1 2 3 4 uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, synaser, ExtCtrls, unitthread;
.
pour les procedures :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 function TMyThread.getLectureState() :boolean; begin //cette fonction te donne l'etat de la variable lecture getLectureState: lecture; end. //-------------------------- procedure TMyThread.stopLecture() ; begin //cette fonction met lecture à false, ce qui revient //à arreter la boucle du thread lecture:=false; end.

en effet j'ai rajouté les unités et plus d'erreur sur "TMemo", mais il me remet maintenant erreur Identifier not Found "MemoMain" !! :evilred:

et pour remettre ma variable sur true il faut que je recrée une autre procédure car je veux pouvoir arrêter l'acquisition des trames et les relancer ?

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, synaser, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      ser: TBlockSerial;
      MyThread: TMyThread;
      lecture : boolean;
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      function getLectureState(): boolean;
      procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
 
 
implementation
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
function TMyThread.getLectureState(): boolean;
begin
 getLectureState: lecture;
end;
 
procedure TMyThread.stopLecture();
begin
lecture:=false;
end;
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
 
procedure TMyThread.Execute;
  var
  newStatus : string;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
        //...
        //[code à exécuter]
        MemoMain.lines.add(ser.RecvTerminated(1000,#13#10));
        //...
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
 
initialization
 
 
end.

je t'avais dit de ajouter un attribut memoMain. A moins que tu ne sais pas ce que veut dire attribut d'un objet auquel, je te conseille de chercher un tutoriel sur la poo.
Ajouter un attribut, revient à declarer une variable qui pourra etre utilisée dans toute la classe.
Code:

1 2 3 4 5 6 7 8 9 10 TMyThread = class(TThread) private //liste des attributs ser: TBlockSerial; MyThread: TMyThread; lecture : boolean; fStatusText : string; FOnShowStatus: TShowStatusEvent; memoMain : TMemo; // notre attribut memoMain
Si tu met lecture à false, tu arrete definitivement le thread, à moins de le relancer (methode resume je crois). Si tu veux, tu peux faire dormir le thread.

18/03/2009, 16h14
showza
en effet je ne savais pas, la programmation n'étant pas du tout mon dommaine, j'ai commencé de programmer il y a trois semaine donc il est vrai que je ne comprend pas bien d'où viennent les erreurs.

en tout cas le problème du mémo est passé maintenant le soucis c'est la procédure:
Code:

1 2 3 4 5 function TMyThread.getLectureState(): boolean; begin getLectureState: lecture; end;
j'ai l'erreur suivante: syntax error,";" expected but ":" found
18/03/2009, 16h27
M.Dlb

Euh, ca ne correspond à rien cette instruction... C'est une déclaration de variable (dans ce cas il faut mettre une clause var avant le begin) ? C'est une affectation (dans ce cas, il faut mettre :=) ? Où est la variable lecture ?

la variable lecture est déjà déclaré regarde le code

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, synaser, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      ser: TBlockSerial;
      MyThread: TMyThread;
      lecture : boolean;
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      MemoMain : TMemo;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      function getLectureState(): boolean;
      procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
 
 
implementation
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
function TMyThread.getLectureState(): boolean;
begin
 getLectureState: lecture;
end;
 
procedure TMyThread.stopLecture();
begin
lecture:=false;
end;
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
 
procedure TMyThread.Execute;
  var
  newStatus : string;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
 
        // -----  code à exécuter
        MemoMain.lines.add(ser.RecvTerminated(1000,#13#10));
 
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
 
initialization
 
 
end.

lecture : boolean;

18/03/2009, 16h51
darrylsite
c'est une erreur de ma part.Mais ça devait rapidement etre corrigée puisque je veux que la fonction retourne la valeur de la variable lecture.
C'est plutot une affectation := au lieu de =.
Code:

1 2 3 4 5 function TMyThread.getLectureState(): boolean; begin getLectureState:= lecture; end;
18/03/2009, 17h05
showza

en effet c'est plus correcte !!
est ce que je dois remettre
var lecture: boolean;
dans mon unitmain

je viens de voir les methode disponible de la classe TThread. Tu peux faire une pause et reprendre la lecture de la trame rien qu'avec les methode resume et suspend.

ce que je vais te demander de faire, c'est de créer un attribut pause de type booleen dans la classe TThread. Ensuite d'ajouter la methode suivante à cette classe :
Code:

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 Type TShowStatusEvent = procedure(Status: String) of Object; TMyThread = class(TThread) private ser: TBlockSerial; MyThread: TMyThread; lecture : boolean; pause : boolean; //<<---->> fStatusText : string; FOnShowStatus: TShowStatusEvent; procedure ShowStatus; protected procedure Execute; override; public procedure marcheArret();// <-------> function getLectureState(): boolean; procedure stopLecture(); procedure setMemo(Memo: TMemo); Constructor Create(CreateSuspended : boolean); property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus; end;
Code:

1 2 3 4 5 6 7 8 9 10 procedure TMyThread.marcheArret; begin if (pause) then self.Resume; else self.Suspend; pause:=not pause; end;
tu initialisera d'abord l'attribut pause dans le constructeur de la classe:
Code:

1 2 3 4 5 6 7 8 constructor TMyThread.Create(CreateSuspended: boolean); begin //... pause:=false; end;
Avec ça, le tour est joué. Pour arreter ou rependre la lecture des trames, il te suffit d'apper la methode marcheArret, à faire à l'appuie d'un bouton par exemple :
Code:

1 2 MyThread.marcheArret;

19/03/2009, 08h34
showza
salut darrylsite !!

ta méthode me plait mais est ce que il serait pas mieux que je mette directement :
Code:

1 2 3 procedure TFrmMain.BTOuvrirClick(Sender: TObject); MyThread.resume;
et
Code:

1 2 3 procedure TFrmMain.BTFermerClick(Sender: TObject); MyThread.suspend;
cela m'éviterai de créer la méthode procedure marcheArret(); ??

Biensur que tu peux le faire. Mais il faut alors eviter d'appeler resume quand le thread est en execution ou suspend quand le thread est dejà arreté.
Pour le faire, on peut utiliser les propriétés (ou attributs) enabled des classes bouton. enabled permet d'activer ou de desactiver un bouton. Tu peux proceder ainsi :
Code:

1 2 3 4 5 6 7 procedure TFrmMain.BTOuvrirClick(Sender: TObject); begin MyThread.resume; BTOuvrir.enabled:=false; //on desactive ouvrir BTFermer.enabled:=true; //on active fermer end;
Code:

1 2 3 4 5 6 7 procedure TFrmMain.BTFermerClick(Sender: TObject); begin MyThread.suspend; BTOuvrir.enabled:=true; //on active ouvrir BTFermer.enabled:=false; //on desactive fermer end;
Il faut aussi penser à desactiver BTFermer dans le constructeur de la form puisque le thread ne s'execute pas automatiquement lors de sa creation.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 procedure TFrmMain.FormCreate(Sender: TObject); begin //----- creation du port ser := TBlockSerial.Create; DetectPortCom; inherited; MyThread := TMyThread.Create(true); MyThread.OnShowStatus := @ShowStatus; MyThread.setMemo(MemoMain); BTFermer.enabled:=false; end;

ok j'avais déjà griser les boutons car pour gestion de port COM il fallait aussi ne pas pouvoir ouvrir le port si il l'était déjà et vis vers sa !!

maintenant le programme se lance sans problème mais la fonction

Code:

MemoMain.Lines.add(ser.RecvTerminated(1000,#13#10));

ne fonctionne pas, au début je pensais que c'était le thread qui ne s'éxecuter pas donc j'ai décider de faire un test en rajoutant

Code:

MemoMain.Text:= 'test execution ok';

et la il m'affiche bien le text donc je ne comprend pas pourquoi

Code:

MemoMain.Lines.add(ser.RecvTerminated(1000,#13#10));

ne fonctionne pas

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, synaser, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      MemoMain : TMemo;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      function getLectureState(): boolean;
      procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
var
 lecture : boolean;
 ser: TBlockSerial;
 newStatus : string;
 
implementation
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
function TMyThread.getLectureState(): boolean;
begin
 lecture := true;
 getLectureState:= lecture;
end;
 
procedure TMyThread.stopLecture();
begin
 lecture:=false;
end;
 
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
 
 
procedure TMyThread.Execute;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
 
        // -----  code à exécuter
        MemoMain.Text:= 'test execution ok';
        MemoMain.Lines.add(ser.RecvTerminated(1000,#13#10));
 
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
initialization
 
end.

19/03/2009, 16h02
darrylsite

Que renvoie cette fonction ser.RecvTerminated(1000,#13#10) ? un string? Et quelle erreur renvoie le compilateur?

salut darrylsite

j'ai trouvé mon erreur en faite je déclarais deux fois la variable ser:TBlockSerial; qui permet le renvoi au fonction de synaser, une fois dans mon unitmain en public et une fois dans mon unithread en privée donc voilà !!

en tout cas merci pour ton aide précieuse darrylsite et voilà le code définitif !!

unitmain

Code:

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
 
 
unit UnitMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, synaser, ExtCtrls, unitthread;
 
type
 
  { TFrmMain }
 
  TFrmMain = class(TForm)
    BtnDetectionPort: TButton;
    BTOuvrir: TButton;
    BTFermer: TButton;
    cbChoixPort: TComboBox;
    cbVitessedetransfert: TComboBox;
    cbBitsdedonnees: TComboBox;
    cbParite: TComboBox;
    cbBitdarret: TComboBox;
    chkHardflow: TCheckBox;
    chkSoftflow: TCheckBox;
    DPS: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MemoMain: TMemo;
    procedure BTFermerClick(Sender: TObject);
    procedure BtnDetectionPortClick(Sender: TObject);
    procedure BTOuvrirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    ser:TBlockSerial;
    procedure DetectPortCOM;
  end; 
 
var
  FrmMain: TFrmMain;
  MyThread:TMyThread;
implementation
 
{ TFrmMain }
 
//Etape 1 Détection du port COM
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  //----- creation du port
  ser := TBlockSerial.Create;
  DetectPortCom;
  BTFermer.enabled:=false;
  BTOuvrir.Enabled:=false;
  inherited;
    MyThread := TMyThread.Create(true);
    MyThread.setMemo(memomain);
end;
 
procedure TFrmMain.BtnDetectionPortClick(Sender: TObject);
begin
BTOuvrir.Enabled:=true;
DetectPortCOm;
end;
 
  // ----- détection des port COM linux Win32
 
procedure TFrmMain.DetectPortCOM;
var
  l: string;
  p: integer;
 
begin
     cbChoixPort.Clear;
 
{$IFDEF WIN32}
      l := GetSerialPortNames;
 
     if l >'' then repeat
       begin
          p :=  pos(',',l);
          if p > 0 then
            begin
              cbChoixPort.Items.Add(copy(L,1,p-1));
              delete(L,1,p);
            end
          else
            cbChoixPort.Items.Add(L);
        end;
      until p = 0;
{$ENDIF}
{$ifdef linux}
 If FileExists('/dev/ttyUSB0') then cbChoixPort.Items.Add('/dev/ttyUSB0');
 If FileExists('/dev/ttyUSB1') then cbChoixPort.Items.Add('/dev/ttyUSB1');
{$ENDIF}
end;
 
//Etape 2 Configuration du port COM
 
procedure TFrmMain.BTOuvrirClick(Sender: TObject);
var
  port : string;
  bauds, databit, stopbit: integer;
  parity : char;
  hardflow, softflow : boolean;
 
begin
  // ----- évite la modification de la configuration du port lors de son fonctionnement
  cbChoixPort.Enabled:=false;
  cbVitessedetransfert.Enabled:=false;
  cbBitsdedonnees.Enabled:=false;
  cbParite.Enabled:=false;
  cbBitdarret.Enabled:=false;
  chkHardflow.Enabled:=false;
  chkSoftflow.Enabled:=false;
  BTOuvrir.enabled:=false;
  BTFermer.Enabled:=true;
 
 
  //----- ouverture du port
  port := cbChoixPort.Items[cbChoixPort.itemIndex];
  ser.Connect(port);
 
  //----- parametrage du port
  case cbVitessedeTransfert.itemindex of
       0 : bauds := 9600;
       1 : bauds := 19200;
       2 : bauds := 38400;
       3 : bauds := 57600;
       4 : bauds := 115200;
  end;
 
  case cbBitsdeDonnees.Itemindex of
       0 : databit := 4;
       1 : databit := 5;
       2 : databit := 6;
       3 : databit := 7;
       4 : databit := 8;
  end;
 
  case cbParite.Itemindex of
       0 : parity := 'N';
       1 : parity := 'O';
       2 : parity := 'E';
       3 : parity := 'M';
       4 : parity := 'S';
  end;
 
  case cbBitdarret.itemindex of
       0 : stopbit := SB1;
       1 : stopbit := SB1andHalf;
       2 : stopbit := SB2;
  end;
 
  softflow := chkSoftflow.checked;
  hardflow := chkHardflow.checked;
 
 
  ser.Config(bauds,databit,parity,stopbit,softflow,hardflow);
 
  // ----- Lancement de l'acquisition des trames
 
  MyThread.getLectureState;
  MyThread.Resume;
 
end;
 
procedure TFrmMain.BTFermerClick(Sender: TObject);
begin
  // ----- permet la modification de la configuration du port, une fois fermer
  cbChoixPort.Enabled:=true;
  cbVitessedetransfert.Enabled:=true;
  cbBitsdedonnees.Enabled:=true;
  cbParite.Enabled:=true;
  cbBitdarret.Enabled:=true;
  chkHardflow.Enabled:=true;
  chkSoftflow.Enabled:=true;
  BTOuvrir.enabled:=true;
  BTFermer.Enabled:=false;
  // ----- fermeture du port COM
  ser.CloseSocket;
  // ----- fermer le thread
  MyThread.stopLecture;
  MyThread.Suspend;
end;
 
procedure TFrmMain.FormCloseQuery(Sender: TObject);
begin
  // ----- libérer le port
  ser.Free;
  // ----- libérer le thread
  MyThread.Terminate;
  MyThread.Free;
  inherited;
end;
 
initialization
  {$I unitmain.lrs}
 
end.

unitthread

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, synaser, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TShowStatusEvent = procedure(Status: String) of Object;
    TMyThread = class(TThread)
    private
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      MemoMain : TMemo;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      outputser : string;
      function getLectureState(): boolean;
      procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
    end;
 
var
 lecture : boolean;
 newStatus : string;
 
implementation
 
uses UnitMain;
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 
 procedure TMyThread.ShowStatus;
  // this method is executed by the mainthread and can therefore access all GUI elements.
  begin
    if Assigned(FOnShowStatus) then
    begin
      FOnShowStatus(fStatusText);
    end;
  end;
 
function TMyThread.getLectureState(): boolean;
begin
 lecture := true;
 getLectureState:= lecture;
end;
 
procedure TMyThread.stopLecture();
begin
 lecture:=false;
end;
 
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
 
 
procedure TMyThread.Execute;
  begin
    fStatusText := 'TMyThread starting...';
    Synchronize(@Showstatus);
    fStatusText := 'TMyThread Running...';
    while (not Terminated) and (lecture) do
      begin
 
        // -----  code à exécuter
        frmMain.MemoMain.lines.add(frmMain.ser.RecvTerminated(1000,#13#10));
 
        if NewStatus <> fStatusText then
          begin
            fStatusText := newStatus;
            Synchronize(@Showstatus);
          end;
      end;
  end;
 
initialization
 
end.

20/03/2009, 12h15
parhelie

Bravo Showsa!

Ça a l'air tout à fait bien comme ça.

Il reste une toute petite erreur dans ta fonction DetectPortCom:
Tu n'aurais pas du mettre la directive

Code:

{$IFDEF WIN32}

Car tu as besoin sous Linux de GetSerialPortNames pour détecter les ports TTYSx.

merci parhelie

oui exact pour détecter les ports TTYSx il faut que j'enlève {$IFDEF WIN32} je viens de le faire même si dans mon application j'utilise que des port COM USB.

j'ai un dernier petit problème avec le thread, j'ai mis mon programme sous linux ce matin et la rien ne marcher
puis j'ai trouvé la réponse à mon problème sur le lien darrylsite http://wiki.lazarus.freepascal.org/M...on_Tutorial/fr

il fallait faire la modification suivante:
Code:

1 2 3 4 5 6 7 8 9 program MyMultiThreadedProgram; {$mode objfpc}{$H+} uses {$ifdef unix} cthreads, {$endif} Interfaces, // this includes the LCL widgetset Forms { add your units here },
maintenant mon application marche mais j'ai un problème avec la reception des trames sous windows tout est nikel (les trames s'affichent toutes les 0,5 seconde) par contre sous linux (l'affichage des trames est aléatoire c'est à dire j'attend 2 secondes et 4 trames s'affichent après 1 seconde et deux trames s'affichent enfin l'affichage ne se fait pas des la réception de l'information).
Est ce que quelqu'un à une idée pour résoudre se problème ??!!!

20/03/2009, 14h40
parhelie

Si c'est un problème (mais es tu capable de lire tes trames à cette vitesse là?), peut-être un MemoMain.rePaint?
20/03/2009, 14h48
showza

une trame toutes les 500 ms ne pose aucun problème au niveau de la vitesse c'est relativement lent !!
je ne connait pas du tout memomain.repaint, à quoi correspond repaint ???

Ton unité contenant le thread contient de variables inutiles. Aussi, un composant du formulaire ne doit pas etre modifier depuis un thread. J'ai eu à modifier un peu l'unité thread. Essaie le si tu veux, et fais nous savoir si le probleme persiste.

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, synaser, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
 
    TMyThread = class(TThread)
    private
      fStatusText : string;
      MemoMain : TMemo;
      lecture : boolean;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      outputser : string;
      function getLectureState(): boolean;
      procedure stopLecture();
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean); 
    end;
 
 
implementation
 
uses UnitMain;
 
//---------------------------------------
 
 constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
 //---------------------------------------
 
 procedure TMyThread.ShowStatus;
  begin
    MemoMain.lines.add(fStatusText);
  end;
  //---------------------------------------
 
function TMyThread.getLectureState(): boolean;
begin
 lecture := true;
 getLectureState:= lecture;
end;
  //---------------------------------------
 
procedure TMyThread.stopLecture();
begin
 lecture:=false;
end;
//---------------------------------------
 
procedure TMyThread.setMemo(Memo: Tmemo);
begin
 MemoMain:=Memo;
end;
//---------------------------------------
 
procedure TMyThread.Execute;
  begin
 
    while (not Terminated) and (lecture) do
      begin
        fStatusText:=frmMain.ser.RecvTerminated(1000,#13#10);
        Synchronize(@Showstatus);       
      end;
  end;
//---------------------------------------
 
initialization
 
end.

23/03/2009, 14h00
showza

j'ai essayé mais pas d'amélioration sur linux, mais ça marche parfaitement sous windows! :oops:
j'ai aussi supprimé toutes les procédures concernant la variable lecture qui ne me servé plus vu que j'utilise les méthodes resume et suspend pour arréter et relancer le thread !!!
23/03/2009, 18h53
parhelie

Si je comprends ta description, tu ne perds pas de trame.

Ton problème serait donc seulement l'affichage.
Pour vérifier cela, tu pourrais créer un fichier log où tu écrirais tes trames + le tic de reception (GetTicCount).

Si c'est le cas, je pense que tu dois pouvoir régler ton problème en forçant le rafraîchissement de ton memo après chaque écriture, soit, comme je te le proposais en faisant MemoMain.Repaint, soit en faisant un délais de quelques ms.

salut parhelie !!

J’avais essayé de mettre l'heure sous le format HH.MM.SS.ZZZ avant chaque trame et je voyais bien que les trames arrivent bien toutes les 500ms à 2 ou 3ms près mais l'affichage ne se faisait pas simultanément mais maintenant que j'ai modifié voilà le nouveau code cela ne marche plus sur linux mais parfaitement sur Windows !!

code unit main

Code:

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 
unit UnitMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, synaser, ExtCtrls, unitthread;
 
type
{ TFrmMain }
    TFrmMain = class(TForm)
    BTDetectionPort: TButton;
    BTOuvrir: TButton;
    BTFermer: TButton;
    cbChoixPort: TComboBox;
    cbVitessedetransfert: TComboBox;
    cbBitsdedonnees: TComboBox;
    cbParite: TComboBox;
    cbBitdarret: TComboBox;
    chkHardflow: TCheckBox;
    chkSoftflow: TCheckBox;
    DPS: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MemoMain: TMemo;
    procedure BTFermerClick(Sender: TObject);
    procedure BTDetectionPortClick(Sender: TObject);
    procedure BTOuvrirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    ser:TBlockSerial;
    procedure DetectPortCOM;
  end; 
 
var
  FrmMain: TFrmMain;
  MyThread:TMyThread;
implementation
 
{ TFrmMain }
 
//Etape 1 Détection du port COM
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  //----- creation du port
  ser := TBlockSerial.Create;
  DetectPortCom;
  BTFermer.enabled:=false;
  BTOuvrir.Enabled:=false;
  inherited;
    MyThread := TMyThread.Create(true);
    MyThread.setMemo(memomain);
end;
 
procedure TFrmMain.BTDetectionPortClick(Sender: TObject);
  begin
    BTOuvrir.Enabled:=true;
    DetectPortCOm;
  end;
 
  // ----- détection des port COM linux Win32
 
procedure TFrmMain.DetectPortCOM;
  var
    l: string;
    p: integer;
 
  begin
    cbChoixPort.Clear;
    l := GetSerialPortNames;
      if l >'' then repeat
        begin
          p :=  pos(',',l);
          if p > 0 then
            begin
              cbChoixPort.Items.Add(copy(L,1,p-1));
              delete(L,1,p);
            end
          else
            cbChoixPort.Items.Add(L);
        end;
      until p = 0;
 
  {$ifdef linux}
    If FileExists('/dev/ttyUSB0') then cbChoixPort.Items.Add('/dev/ttyUSB0');
    If FileExists('/dev/ttyUSB1') then cbChoixPort.Items.Add('/dev/ttyUSB1');
  {$ENDIF}
  end;
 
//Etape 2 Configuration du port COM
 
procedure TFrmMain.BTOuvrirClick(Sender: TObject);
  var
    port : string;
    bauds, databit, stopbit: integer;
    parity : char;
    hardflow, softflow : boolean;
 
  begin
    // ----- évite la modification de la configuration du port lors de son fonctionnement
    cbChoixPort.Enabled:=false;
    cbVitessedetransfert.Enabled:=false;
    cbBitsdedonnees.Enabled:=false;
    cbParite.Enabled:=false;
    cbBitdarret.Enabled:=false;
    chkHardflow.Enabled:=false;
    chkSoftflow.Enabled:=false;
    BTOuvrir.enabled:=false;
    BTFermer.Enabled:=true;
    BTDetectionPort.Enabled:=false;
 
  //----- ouverture du port
   port := cbChoixPort.Items[cbChoixPort.itemIndex];
   ser.Connect(port);
 
  //----- parametrage du port
   case cbVitessedeTransfert.itemindex of
       0 : bauds := 9600;
       1 : bauds := 19200;
       2 : bauds := 38400;
       3 : bauds := 57600;
       4 : bauds := 115200;
   end;
 
   case cbBitsdeDonnees.Itemindex of
       0 : databit := 4;
       1 : databit := 5;
       2 : databit := 6;
       3 : databit := 7;
       4 : databit := 8;
   end;
 
   case cbParite.Itemindex of
       0 : parity := 'N';
       1 : parity := 'O';
       2 : parity := 'E';
       3 : parity := 'M';
       4 : parity := 'S';
   end;
 
   case cbBitdarret.itemindex of
       0 : stopbit := SB1;
       1 : stopbit := SB1andHalf;
       2 : stopbit := SB2;
   end;
 
  softflow := chkSoftflow.checked;
  hardflow := chkHardflow.checked;
 
  ser.Config(bauds,databit,parity,stopbit,softflow,hardflow);
 
  // ----- Lancement de l'acquisition des trames
 
  //MyThread.getLectureState;
  MyThread.Resume;
 
  end;
 
procedure TFrmMain.BTFermerClick(Sender: TObject);
  begin
    // ----- permet la modification de la configuration du port, une fois fermer
    cbChoixPort.Enabled:=true;
    cbVitessedetransfert.Enabled:=true;
    cbBitsdedonnees.Enabled:=true;
    cbParite.Enabled:=true;
    cbBitdarret.Enabled:=true;
    chkHardflow.Enabled:=true;
    chkSoftflow.Enabled:=true;
    BTOuvrir.enabled:=true;
    BTFermer.Enabled:=false;
    BTDetectionPort.Enabled:=true;
    // ----- fermer le thread
    MyThread.Suspend;
    // ----- fermeture du port COM
    ser.CloseSocket;
  end;
 
procedure TFrmMain.FormCloseQuery(Sender: TObject);
  begin
    // ----- libérer le thread
    MyThread.Terminate;
    MyThread.Free;
    inherited;
    // ----- libérer le port
    ser.Free;
  end;
 
initialization
  {$I unitmain.lrs}
 
end.

code unit thread

Code:

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
 
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TMyThread = class(TThread)
    private
      fStatusText : string;
      MemoMain : TMemo;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
    end;
 
 
implementation
 
uses UnitMain;
 
constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    FreeOnTerminate := true;
    inherited Create(CreateSuspended);
  end;
 
procedure TMyThread.ShowStatus;
  begin
    MemoMain.lines.add(fStatusText);
  end;
 
procedure TMyThread.setMemo(Memo: Tmemo);
  begin
    MemoMain:=Memo;
  end;
 
 
procedure TMyThread.Execute;
  begin
    while (not Terminated) do
      begin
        fStatusText:= frmMain.ser.RecvTerminated(1000,#13#10);
        Synchronize(@Showstatus);
      end;
  end;
 
 
initialization
 
end.

enfin j'ai trouvé le code qui fonctionne parfaitement sous windows et linux !!
:lol:

voilà la bête:

unitmain

Code:

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
187
188
189
190
191
192
193
194
195
196
197
unit UnitMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, synaser, ExtCtrls, unitthread;
 
type
{ TFrmMain }
    TFrmMain = class(TForm)
    BTDetectionPort: TButton;
    BTOuvrir: TButton;
    BTFermer: TButton;
    cbChoixPort: TComboBox;
    cbVitessedetransfert: TComboBox;
    cbBitsdedonnees: TComboBox;
    cbParite: TComboBox;
    cbBitdarret: TComboBox;
    chkHardflow: TCheckBox;
    chkSoftflow: TCheckBox;
    DPS: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    MemoMain: TMemo;
    procedure BTFermerClick(Sender: TObject);
    procedure BTDetectionPortClick(Sender: TObject);
    procedure BTOuvrirClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    ser:TBlockSerial;
    procedure DetectPortCOM;
  end; 
 
var
  FrmMain: TFrmMain;
  MyThread:TMyThread;
implementation
 
{ TFrmMain }
 
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
  //----- creation du port
  ser := TBlockSerial.Create;
  DetectPortCom;
  BTFermer.enabled:=false;
  BTOuvrir.Enabled:=false;
end;
 
procedure TFrmMain.BTDetectionPortClick(Sender: TObject);
  begin
    BTOuvrir.Enabled:=true;
    DetectPortCOm;
  end;
 
  // ----- détection des port COM linux Win32
 
procedure TFrmMain.DetectPortCOM;
  var
    l: string;
    p: integer;
 
  begin
    cbChoixPort.Clear;
    l := GetSerialPortNames;
      if l >'' then repeat
        begin
          p :=  pos(',',l);
          if p > 0 then
            begin
              cbChoixPort.Items.Add(copy(L,1,p-1));
              delete(L,1,p);
            end
          else
            cbChoixPort.Items.Add(L);
        end;
      until p = 0;
 
  {$ifdef linux}
    If FileExists('/dev/ttyUSB0') then cbChoixPort.Items.Add('/dev/ttyUSB0');
    If FileExists('/dev/ttyUSB1') then cbChoixPort.Items.Add('/dev/ttyUSB1');
  {$ENDIF}
  end;
 
 
procedure TFrmMain.BTOuvrirClick(Sender: TObject);
  var
    port : string;
    bauds, databit, stopbit: integer;
    parity : char;
    hardflow, softflow : boolean;
 
  begin
  inherited;
    MyThread := TMyThread.Create(true);
    MyThread.setMemo(memomain);
 
    // ----- évite la modification de la configuration du port lors de son fonctionnement
    cbChoixPort.Enabled:=false;
    cbVitessedetransfert.Enabled:=false;
    cbBitsdedonnees.Enabled:=false;
    cbParite.Enabled:=false;
    cbBitdarret.Enabled:=false;
    chkHardflow.Enabled:=false;
    chkSoftflow.Enabled:=false;
    BTOuvrir.enabled:=false;
    BTFermer.Enabled:=true;
    BTDetectionPort.Enabled:=false;
 
  //----- ouverture du port
   port := cbChoixPort.Items[cbChoixPort.itemIndex];
   ser.Connect(port);
 
  //----- parametrage du port
   case cbVitessedeTransfert.itemindex of
       0 : bauds := 9600;
       1 : bauds := 19200;
       2 : bauds := 38400;
       3 : bauds := 57600;
       4 : bauds := 115200;
   end;
 
   case cbBitsdeDonnees.Itemindex of
       0 : databit := 4;
       1 : databit := 5;
       2 : databit := 6;
       3 : databit := 7;
       4 : databit := 8;
   end;
 
   case cbParite.Itemindex of
       0 : parity := 'N';
       1 : parity := 'O';
       2 : parity := 'E';
       3 : parity := 'M';
       4 : parity := 'S';
   end;
 
   case cbBitdarret.itemindex of
       0 : stopbit := SB1;
       1 : stopbit := SB1andHalf;
       2 : stopbit := SB2;
   end;
 
  softflow := chkSoftflow.checked;
  hardflow := chkHardflow.checked;
 
  ser.Config(bauds,databit,parity,stopbit,softflow,hardflow);
 
  // ----- Lancement de l'acquisition des trames
  MyThread.Resume;
end;
 
procedure TFrmMain.BTFermerClick(Sender: TObject);
  begin
    // ----- permet la modification de la configuration du port, une fois fermer
    cbChoixPort.Enabled:=true;
    cbVitessedetransfert.Enabled:=true;
    cbBitsdedonnees.Enabled:=true;
    cbParite.Enabled:=true;
    cbBitdarret.Enabled:=true;
    chkHardflow.Enabled:=true;
    chkSoftflow.Enabled:=true;
    BTOuvrir.enabled:=true;
    BTFermer.Enabled:=false;
    BTDetectionPort.Enabled:=true;
 
    // ----- fermeture du port COM
    ser.CloseSocket;
 
    // ----- fermer le thread
    MyThread.Terminate;
    inherited;
  end;
 
procedure TFrmMain.FormCloseQuery(Sender: TObject);
  begin
    // ----- libérer le port
    ser.Free;
  end;
 
initialization
  {$I unitmain.lrs}
 
end.

unitthread

Code:

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
unit UnitThread;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, FileUtil, Dialogs,
  StdCtrls, ExtCtrls;
 
Type
    TMyThread = class(TThread)
    private
      fStatusText : string;
      MemoMain : TMemo;
      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      procedure setMemo(Memo: TMemo);
      Constructor Create(CreateSuspended : boolean);
    end;
 
 
implementation
 
uses UnitMain;
 
constructor TMyThread.Create(CreateSuspended : boolean);
  begin
    inherited Create(CreateSuspended);
    FreeOnTerminate := true;
  end;
 
procedure TMyThread.setMemo(Memo: Tmemo);
  begin
    MemoMain:=Memo;
  end;
 
procedure TMyThread.ShowStatus;
  begin
    MemoMain.lines.add(fStatusText);
  end;
 
procedure TMyThread.Execute;
  begin
    while (not Terminated) do
      begin
        fStatusText:= frmMain.ser.RecvTerminated(1000,#13#10);
        if fStatusText <> '' then Synchronize(@Showstatus);
      end;
  end;
 
 
initialization
 
end.

24/03/2009, 16h39
darrylsite

Citation:

if fStatusText <> '' then Synchronize(@Showstatus);

Souvent, les trucs les plus simples sont difficiles à trouver :mrgreen:
25/03/2009, 09h24
showza

lol darrylsite !!
Je suis entièrement d'accord avec toi !!
J’ai réalisé une autre modification aussi je ne sais pas si tu l'as remarqué, maintenant je crée mon thread à l'aide du bouton ouvrir et le termine avec le bouton fermer, c'est à dire que je n'utilise plus la méthode suspend qui ne marché pas sous linux.

Maintenant que j'ai réalisé cette première étape il va falloir que je récupère mes trames pour les transformés en graphique en utilisant Tchart.
Donc je pense recréer une discussion à ce sujet et j'espère pouvoir compter sur votre aide pour cette nouvelle étape !! :yaisse2:

en tout cas merci Darrylsite et Parhelie !!
25/03/2009, 10h42
parhelie

Code:

que je récupère mes trames pour les transformés en graphique en utilisant Tchart

...tu vas t'amuser!
c'est du composant plot que tu as besoin!

(.../lazarus/components/plot/plot.lpk)
25/03/2009, 12h15
showza

Citation:

...tu vas t'amuser!
c'est du composant plot que tu as besoin!

(.../lazarus/components/plot/plot.lpk)

oui à mon avis je vais m'amuser mais bon j'ai des bon guide sur le forum !!
J'ai plus peur de rien ! lol