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 :
et voici le code de l'application ou ça ne fonctionne pas...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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.
Merci pour votre aide, la je bloque...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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.
Partager