[D7] Comment programmer un progress bar ?

Version imprimable

10/02/2018, 11h49
seifrf

[D7] Comment programmer un progress bar ?

Bonjour,

J'ai deux fiches. La première fiche est une forme d’accueil et la deuxième fiche contient un progress bar. Je veux que, quand j'ouvre mon projet et que je l’exécute, la deuxième fiche du progress bar s'affiche et que le progress bar fait un signe de chargement du contenu.

Merci d'avance !
10/02/2018, 15h58
Roland Chastain

Bonjour !

Voici un exemple trouvé dans les sources Delphi :

http://nono40.developpez.com/sources/source0030/
10/02/2018, 21h35
seifrf

merci je vais essayer
21/02/2018, 15h01
cantador

Bonjour seifrf ,

Tu peux créer un SplashScreen (avec un logo ou une image) sur une ouverture d'un DataModule (contenant l'ensemble de tes tables, si tu en as bien sûr..)
Ainsi, ta barre de progression avancera au fur et à mesure de l'ouverture de tes tables ou Query
et une fois l'opération terminée, ta forme s'ouvrira.

@+
15/03/2018, 19h29
seifrf

bonjour, désole pour le retard tu peut me donner un exemple comment faire cela ?
15/03/2018, 20h51
gbegreg

Bonsoir,

Une petite recherche dans la FAQ Delphi https://delphi.developpez.com/faq/?p...-splash-screen ;)

splashscreen

Bonsoir,
un premier exemple simple utilisant l'alphablending de la forme :

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses Splash;
 
{$R *.dfm}
 
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  Sleep(1000);
  for i := 255 downto 1 do
  begin
    FSplashScreen.AlphaBlendValue := i;
    Sleep(4);
  end;
  FSplashScreen.Free;
end;
 
end.

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
 
unit Splash;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, jpeg, JvExControls, JvComponent,
  JvSpecialProgress;
 
type
  TFSplashScreen = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Panel2: TPanel;
    ProgressBar1: TJvSpecialProgress;
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  FSplashScreen: TFSplashScreen;
 
implementation
 
{$R *.DFM}
 
end.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
program Project1;
 
uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Splash in 'Splash.pas' {FSplashScreen};
 
{$R *.res}
 
begin
  Application.Initialize;
  FSplashScreen := TFSplashScreen.Create(Application);
  FSplashScreen.Show;
  FSplashScreen.Refresh;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
 
end.

il faut mettre la propriété alphablend à true dans FSplashScreen
@+

splashScreen_2

on peut aussi retirer l'alphablending
et activer la barre de progression :

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
 
      try
        FSplashScreen := TFSplashScreen.Create(Application);
        FSplashScreen.Show;
        FSplashScreen.Refresh;
        FSplashScreen.ProgressBar1.Maximum := Max;   // Nombre maxi de Query à ouvrir + le reste
        FSplashScreen.ProgressBar1.Position := j;
 
        with DataModule1 do
        begin
          for i := 0 to ComponentCount - 1 do
            if Components[i] is TIBOQuery then                // il faut mettre la classe de tes Query
 
              if TIBOQuery(Components[I]).SQL.Count <> 0 then
              begin
                try
                  FSplashScreen.ProgressBar1.Position := j;
                  TIBOQuery(Components[I]).Close;
                  TIBOQuery(Components[I]).Open;
                  inc(j, 1);
                except
                  Showmessage(Components[i].Name);
                end;
              end;
         end;
 
        FSplashScreen.ProgressBar1.Position := j;
 
        if not assigned(DMETAT) then                                    // tu peux en profiter pour créer d'autres formes
          Application.CreateForm(TDMETAT, DMETAT);
        inc(j, 1);
        FSplashScreen.ProgressBar1.Position := j;
 
        if not assigned(FormSearch) then
          Application.CreateForm(TFormSearch, FormSearch);  // tu peux en profiter pour créer d'autres formes
        inc(j, 1);
        FSplashScreen.ProgressBar1.Position := j;
 
      finally
        Form1.Show;
        Form1.WindowState := wsMaximized;
        if Assigned(FSplashScreen) then
        begin
          FSplashScreen.Hide;
          FSplashScreen.Free;
        end;
      end;

la fome FSplashScreen est à placer dans le liste des formes non créées automatiquement

@+

15/03/2018, 22h56
cantador

et aussi la FAQ :

https://www.developpez.net/forums/d1...-progress-bar/

bon coding
16/03/2018, 09h58
seifrf

merci cantador

salut

dans une unité a part

Code:

1
2
3
 
Type
  TOnProgress = procedure (const Text: string; const iCur,iMax: Integer) of object;

dans la fiche principale

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
 
//**********************************************************
procedure TFrmPrincipal.BtnTravailClick(Sender: TObject);
begin
  dm := TdmJetravail.create(self);
  dm.Onprogress := EventProgress ;
  dm.Jetravail;
  dm.Onprogress := nil;
  dm.free;
end;
//**********************************************************
procedure TFrmPrincipal.EventProgress(const Text: string; const iCur,iMax: Integer);
var
  pcent: integer;
  MustRefresh: boolean;
begin
   if (iCur<0) or (iMax<0) then
   begin
      Progressbar.visible := False;
      Progressbar.Position := 0;
   end
   else
   begin
       Progressbar.visible := True;
       MustRefresh := False;
       pcent := 0;
       if iMax<>0 then
	   pCent := (iCur * 100) div iMax;
 
	if pCent<>Progressbar.Position then
	begin
	    Progressbar.Position := pCent;
	    MustRefresh := True;
	end;
	if MustRefresh then
	    Application.ProcessMessages;
   end;
end;

dans la seconde parti

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 
  TdmJetravail = Class(..)
   fonprogress : TonProgress ;
 Public 
    Procedure Jetravail;
    Procedure Progress(const Text: string; const iCur,iMax: Integer);
    Property onProgress : TOnProgress read fOnProgress write fOnProgress; 
 end;
....
//**********************************************************
Procedure TdmJetravail.Progress(const Text: string; const iCur,iMax: Integer);
begin
  if assigned(fOnProgress) then
    fOnProgress(Text,iCur,iMax);
end;
//**********************************************************
Procedure TdmJetravail.Jetravail
begin
  For iCur := 0 to Imax Do 
  begin
     OnBosseCetteLigne(iCur);
     Progress('Je Fais mon boulot',iCur,Imax);
  end;
end;
//**********************************************************