Discussion :

[Moez.B]

Bonjour
Je viens faire avec un essai tout en essayant d'appeler le ShowModal de ma fiche.
Voici le Code du main :

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
 
unit uMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uProgressForm, uThreadProgress;
 
type
  TMainForm = class(TForm)
    btnCallThreadProgress: TButton;
    procedure btnCallThreadProgressClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
procedure TMainForm.btnCallThreadProgressClick(Sender: TObject);
Var
  ProgressForm: TProgressForm;
begin
  TThread.NameThreadForDebugging('Principal');
  ProgressForm := TProgressForm.Create(Self);
  Try
    ProgressForm.ProgressBar.Properties.Min := 0;
    ProgressForm.ProgressBar.Properties.Max := 1000;
    ProgressForm.ProgressBar.Update;
    ProgressForm.ShowModal;
  Finally
    //
  End;
end;
 
end.

Dans le FormActivate de ma jauge de progression, je fais Appel à la création de mon Thread , je crée mon gestionnaire de message pour intercepter le message WM_USER+1 (ModalResult := mrOk)

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
 
unit uProgressForm;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, cxContainer, cxEdit, dxSkinsCore, dxSkinBlack,
  dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom,
  dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
  dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
  dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
  dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
  dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
  dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
  dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
  dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
  dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust,
  dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinsDefaultPainters,
  dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue,
  cxProgressBar;
 
type
  TProgressForm = class(TForm)
    ProgressBar: TcxProgressBar;
    procedure FormActivate(Sender: TObject);
  private
    { Déclarations privées }
  public
    procedure HandleModalResult(var Msg : TMessage); message WM_USER + 1;
  end;
 
var
  ProgressForm: TProgressForm;
 
implementation
 
{$R *.dfm}
 
{ TProgressForm }
 
Uses uThreadProgress;
 
procedure TProgressForm.FormActivate(Sender: TObject);
Var
  ThreadProgress: TThreadProgress;
begin
  ThreadProgress := TThreadProgress.Create(Self);
end;
 
procedure TProgressForm.HandleModalResult(var Msg: TMessage);
begin
  ModalResult := mrOk;
end;
 
end.

Et dans le TThread le code n'a rien de spécial : juste une boucle qui simule un traitement

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
 
unit uThreadProgress;
 
interface
 
uses
  Classes, cxProgressBar, Windows, Messages, uProgressForm;
 
type
  TThreadProgress = class(TThread)
  private
    FGaugeProgress: TProgressForm;
    procedure UpdateGaugeProgress();
  protected
    procedure Execute; override;
  public
    constructor Create(AGaugeProgress: TProgressForm);
  end;
 
implementation
 
{ TThreadProgress }
 
constructor TThreadProgress.Create(AGaugeProgress: TProgressForm);
begin
  Inherited Create(False);
  FGaugeProgress  := AGaugeProgress;
  FreeOnTerminate := True;
end;
 
procedure TThreadProgress.Execute;
begin
  while not Terminated do
    UpdateGaugeProgress();
  PostMessage(FGaugeProgress.Handle, WM_USER+1, 0, 0);
end;
 
procedure TThreadProgress.UpdateGaugeProgress;
Var
  i: Integer;
begin
  TThread.NameThreadForDebugging('Secondaire');
  For i:=0 to 100000 do
  Begin
    Synchronize(procedure
    Begin
      FGaugeProgress.ProgressBar.Position := FGaugeProgress.ProgressBar.Position + 1;
      FGaugeProgress.ProgressBar.Update;
    end
    );
    //Sleep(500);
  End;
  Terminate;
end;
 
end.

Cet exemple fonctionne très bien : la fiche de la jauge est créée dans le thread princiapl, elle est passée dans le Thread secondaire dans son Execute. A la fin du traitement, je fais le post du message WM_USER+1, la fiche de progression se ferme ainsi. Un terminate et mon Thread est libéré et je reviens à mon Thread principal de VCL.

Objectif atteint

Merci tout le monde pour vote aide