[Lazarus] Thread et accès aux objets d'un TForm

Thread et accès aux objets d'un TForm

Bonjour,

Je rencontre un soucis avec l'utilisation d'un TThread...

J'ai fait une application dont le TForm est la fenetre principale de l'application, avec l'utilisation d'un TThread et ça fonctionne. Je fais la meme chose dans une autre application mais cette fois ci sur un TForm créé dynamiquement et affiché en modal et la je n'ai pas accès aux objets du TForm...

Je ne sais pas si cela à un lien mais je ne comprends pas pourquoi cela fonctionne dans le premier cas et pas dans l'autre...

Voici le code de l'application ou le Thread fonctionne :

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
 
unit umain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, fpspreadsheetctrls, comobj, variants, LConvEncoding,
  DateTimePicker, uinventaire;
 
type
 
  { TFrmMain }
 
  TFrmMain = class(TForm)
    DateInv: TDateTimePicker;
    GbxFichiers: TGroupBox;
    GbxJournal: TGroupBox;
    GbxDateInv: TGroupBox;
    Img: TImageList;
    LstFiles: TListBox;
    MemErrors: TMemo;
    PBar: TProgressBar;
    RdgTraitement: TRadioGroup;
    RdgBase: TRadioGroup;
    StsBar: TStatusBar;
    classeur: TsWorkbookSource;
    TlbMain: TToolBar;
    TlbOpen: TToolButton;
    TlbDelete: TToolButton;
    TlbSave: TToolButton;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RdgTraitementClick(Sender: TObject);
    procedure TlbDeleteClick(Sender: TObject);
    procedure TlbOpenClick(Sender: TObject);
    procedure TlbSaveClick(Sender: TObject);
  private
 
         //Affichage du suivi de traitement
         procedure EcrireTraitement(index : integer; indexmax : integer);
         //Affichage des étapes
         procedure EcrireEtape(etape : integer);
 
         //Vérifie si la cellule contient le nom d'un emplacement
         function IsEmplacement(ligne : integer) : boolean;
         //Vérifie si la cellule contient la référence d'un article
         function IsArticle(ligne : integer) : boolean;
 
         //Ecriture de la ligne dans la grille
         procedure EcrireArticle(var grille : TInventaire; emplacement : string; article : string; index : integer);
         //récupère la derniere ligne du fichier
         function LireIdxfin : integer;
         //Vide la colonne des quantites saisies "M" et renvoi la derniere ligne du fichier
         function ViderQuantites : integer;
 
         //Vérification du fichier
         function VerifSaisie(numfichier : integer;ligne : integer) : boolean;
  public
 
  end;
 
  Type
    TTraitement = class(TThread)
    private
 
      //Prepare les fichiers d'inventaire
      procedure PrepareInventaire;
      //Compilation de plusieurs fichiers
      procedure Compilation;
    protected
      procedure Execute; override;
    public
      Constructor Create(CreateSuspended : boolean);
    end;
 
CONST
  INDICE_MAX = 0;
  LECTURE_FICHIER = 1;
  ECRITURE_FICHIER = 2;
  VIDE = 3;
  COMPILER = 4;
  ECRITURE_SYNTHESE = 5;
 
var
  FrmMain: TFrmMain;
  XLApp: OLEVariant;
 
 
implementation
 
 
{$R *.lfm}
 
{ TFrmMain }
 
procedure TFrmMain.FormCreate(Sender: TObject);
begin
     //Attribution de la date du jour
     DateInv.Date:=Now;
end;
 
constructor TTraitement.Create(CreateSuspended : boolean);
begin
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;
 
procedure TTraitement.Execute;
begin
    while not Terminated do
          if FrmMain.RdgTraitement.ItemIndex = 0 then
             Synchronize(@prepareinventaire)
          else
              Synchronize(@Compilation);
end;
 
//Prepare les fichiers d'inventaire
procedure TTraitement.PrepareInventaire;
Var idxfiles, idxsheet, idxmax : integer;
begin
     With FrmMain do
     begin
 
            //Acces possible aux objets de la Form
 
     end;
     Terminate;
     showmessage('Fin du traitement.');
end;
 
//Compilation de plusieurs fichiers
procedure TTraitement.Compilation;
begin
     With FrmMain do
     begin
 
          //Acces possible aux objets de la Form
 
     end;
     Terminate;
     showmessage('Fin du traitement.');
end;
 
 
//Vérification du fichier : non bloquant
function TFrmMain.VerifSaisie(numfichier : integer;ligne : integer) : boolean;
var lettre, phrase : string;
    valeur : double;
begin
      //Acces possible depuis le Thread
 
end;
 
 
 
//Sur click de la sauvegarde
procedure TFrmMain.TlbSaveClick(Sender: TObject);
var Traitement : TTraitement;
begin
 
 
     //Execution du traitement
     try
        traitement := TTraitement.Create(true);
        traitement.Start;
     finally
 
     end;
 
end;
 
end.

et voici le code de l'application ou ça 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
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
 
unit uremisesclt;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
  Grids, ExtCtrls, ComCtrls, udm, utraitement, urequetes;
 
type
 
  { TFrmRemises }
 
 
  TFrmRemises = class(TForm)
    BtnRech: TBitBtn;
    CbxBase: TComboBox;
    GbxBase: TGroupBox;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    LblClt: TLabel;
    LblCtt: TLabel;
    RdgSommeil: TRadioGroup;
    StbEtape: TStatusBar;
    StrClients: TStringGrid;
    TlbMenu: TToolBar;
    TlbExpCsv: TToolButton;
    procedure BtnRechClick(Sender: TObject);
    procedure CbxBaseChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StrClientsHeaderClick(Sender: TObject; IsColumn: Boolean;
      Index: Integer);
    procedure TlbExpCsvClick(Sender: TObject);
  private
         //Requete de recherche
         //function LireRecherche(IsFamille : boolean) : string;
 
         //Traitement d'ecriture du fichier ou création du rapport
         //procedure EcritureRemises(traitement : integer);
 
        //Ecriture de la grille en CSV
         procedure EcrireCSV(var grille : TStringGrid);
         //Vérification de la saisie de recherche
         function VerifSaisie : boolean;
 
  public
        //Modification du constructeur
        constructor Create(AOwner : TComponent);override;
  end;
 
  Type
      TTraitement = class(TThread)
        private
             //Traitement d'ecriture du fichier ou création du rapport
             procedure EcritureRemises;
        protected
             procedure Execute; override;
        public
             Constructor Create(CreateSuspended : boolean);
    end;
 
 
 
 
CONST ECRITURE_FICHIER = 0;
      ECRITURE_RAPPORT = 1;
 
var
  FrmRemises: TFrmRemises;
  odbc : string;
  exec : integer;
 
implementation
 
{$R *.lfm}
 
{ TFrmRemises }
 
//Modification du constructeur
constructor TFrmRemises.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
     //Chargement de la liste des sociétés
     dm.EcrireCbx(SQLLireSocietes,CbxBase);
     odbc := '';
end;
 
//Constructeur du Thread
Constructor TTraitement.Create(CreateSuspended : boolean);
begin
     FreeOnTerminate := true;
     inherited Create(CreateSuspended);
end;
 
procedure TTraitement.Execute;
begin
     while not terminated do
           Synchronize(@EcritureRemises);
end;
 
procedure TFrmRemises.BtnRechClick(Sender: TObject);
var traitement : TTraitement;
begin
     //Ecriture du rapport
     exec := ECRITURE_RAPPORT;
     try
        traitement := TTraitement.Create(true);
        traitement.Start;
     finally
     end;
 
end;
 
procedure TFrmRemises.TlbExpCsvClick(Sender: TObject);
var traitement : TTraitement;
begin
     //Ecriture du fichier
     exec := ECRITURE_FICHIER;
     try
        traitement := TTraitement.Create(true);
        traitement.Start;
     finally
     end;
end;
 
 
 
//Traitement d'ecriture du fichier ou création du rapport
procedure TTraitement.EcritureRemises;
var Gres : TStringGrid;
begin
 
     with FrmRemises do
     begin
          //Acces IMPOSSIBLE aux objets de la Form
     end;
     Terminate;
 
end;
 
 
//Vérification de la saisie de recherche
function TFrmRemises.VerifSaisie : boolean;
begin
        //Pas d'acces aux objets depuis le Thread
end;
 
end.

Merci pour votre aide, la je bloque...

Bonjour,

L'erreur rencontrée est-elle une Exception Acces Violation lors du with FrmRemises ?
Dans ce cas, lors de sa création dynamique, la référence à la fiche remises est-elle bien attribuée à la variable FrmRemises ?

C'est tout a fait ça, c'est bien cette erreur la et c'est à ce niveau, par contre je ne comprends "la référence à la fiche remises est-elle bien attribuée à la variable FrmRemises" je crois que je ne sais pas le faire, auriez vous un exemple s'il vous plait ?

Voici comment j'appelle la fiche :

Code:

1
2
3
4
5
6
7
8
9
10
 
procedure TFrmMain.MICltRemisesClick(Sender: TObject);
var Remises : TFrmRemises;
begin
 
     //Création de l'objet d'affichage des remises
     Remises := TfrmRemises.Create(self);
     //Affichage de la fenêtre
     Remises.ShowModal;
end;

Salut

c'est normal car dans:
Code:

1 2 3 4 5 6 7 8 9 procedure TFrmMain.MICltRemisesClick(Sender: TObject); var Remises : TFrmRemises; begin //Création de l'objet d'affichage des remises Remises := TfrmRemises.Create(self); //Affichage de la fenêtre Remises.ShowModal; end;
Tu initalises Remises : TFrmRemises; qui est une variable locale, et qui n'est donc pas accessible globalement.
A la base tu as déclaré var FrmRemises: TFrmRemises; et c'est cette variable qu'utilise ton Thread. Erreur bête et méchante d'inattention, mais courante :zoubi:.

Tu aurais du faire dans l'unité de ta form principale :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 implementation uses uremisesclt; // Attention à bien déclarer l'unit ici et par dans interface et de faire attention que tu n'as pas déja une classe TTraitement (donc du même nom que dans ta form principale) procedure TFrmMain.MICltRemisesClick(Sender: TObject); begin //Création de l'objet d'affichage des remises if not(Assigned(FrmRemises)) then FrmRemises := TfrmRemises.Create(self); //Affichage de la fenêtre FrmRemises.ShowModal; end;
PS : N'oublis pas d'arrêter ton thread lorsque tu fermes ta fenêtre "modal" avec l'événement onCloseQuery et de bien libérer FrmRemises lorsque tu quittes ton application.

A+

Jérôme

Merci beaucoup pour votre aide, j'ai compris mon erreur

Bonne journée