TrackBar sur fonction LoadFromFile

**colorid** · 14/12/2009, 14h00

Bonjour,

J'ai un fichier bitmap de plus de 400 Mo à charger avec la fonction Tbitmap.LoadFromFile.

Comment activer un TTrackbar pour suivre la progression du chagement ?

Merci à l'avance pour la réponse

A+

**peter27x** · 14/12/2009, 14h09

Tu peux aller voir de ce coté là ==> TBitmap.onProgress:

Description

Pour certains descendants de TGraphic, OnProgress se produit lors de processus lents comme le chargement,l'enregistrement ou la transformation des données de l'image. OnProgress permet aux applications de donner à l'utilisateur une indication de l'avancement d'un processus lent.

**colorid** · 14/12/2009, 15h07

Merci pour cette info.
Mais comment lier la position de progressBar avec Onprogress et comment initaialiser Max et Min du TprogressBar Avant le loadFromFile ?

**Dr.Who** · 14/12/2009, 17h20

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
unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;
 
type
  TForm3 = class(TForm)
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure DoBmpProgress(Sender: TObject; Stage: TProgressStage;
    PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  public
    { Déclarations publiques }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
function ReadBitmapHeader(const FileName: string; var aBFH: BITMAPFILEHEADER; var aBIH: BITMAPINFOHEADER): boolean;
begin
  result := false;
  with TFileStream.Create(FileName, fmOpenRead) do
  try
    read(aBFH, SizeOf(BITMAPFILEHEADER));
    read(aBIH, SizeOf(BITMAPINFOHEADER));
    result := true and (aBFH.bfType = $4D42);
  finally
    Free;
  end;
end;
 
var
  Bmp : TBitmap;
  Bfh : BITMAPFILEHEADER;
  Bih : BITMAPINFOHEADER;
  BmpFile : string;
 
 
procedure TForm3.DoBmpProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  ProgressBar1.Position := PercentDone;
  Caption := Msg;
end;
 
procedure TForm3.FormCreate(Sender: TObject);
begin
  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
 
  BmpFile := 'C:\Dossier\Fichier.bmp';
 
  Bmp := TBitmap.Create;
  Bmp.OnProgress := DoBmpProgress;
 
  if ReadBitmapHeader(BmpFile, Bfh, Bih) then
    if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
      Bmp.LoadFromFile(BmpFile);
end;
 
procedure TForm3.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
end;
 
end.

**colorid** · 14/12/2009, 19h41

La fonction de lecture de l'entête fichier fonctionne bien

Mais la

**colorid** · 14/12/2009, 19h42

mais la progressbar ne se met pas à jour

**Montor** · 14/12/2009, 19h56

Pas tout lu vérifier le syntaxe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
procedure TForm3.DoBmpProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  ProgressBar1.Position := PercentDone;
  Caption := Msg;
  Application.processmesages
end;

**Dr.Who** · 14/12/2009, 20h31

et pour eviter la surcharge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
procedure TForm3.DoBmpProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  ProgressBar1.Position := PercentDone;
  Caption := Msg;
  if (PercentDone mod 5) = 0 then
    Application.ProcessMessages;
end;

**colorid** · 14/12/2009, 20h47

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;
 
type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    procedure DoBmpProgress(Sender: TObject; Stage: TProgressStage;
    PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function ReadBitmapHeader(const FileName: string; var aBFH: BITMAPFILEHEADER; var aBIH: BITMAPINFOHEADER): boolean;
begin
  result := false;
  with TFileStream.Create(FileName, fmOpenRead) do
  try
    read(aBFH, SizeOf(BITMAPFILEHEADER));
    read(aBIH, SizeOf(BITMAPINFOHEADER));
    result := true and (aBFH.bfType = $4D42);
  finally
    Free;
  end;
end;
 
var
  Bmp : TBitmap;
  Bfh : BITMAPFILEHEADER;
  Bih : BITMAPINFOHEADER;
  BmpFile : string;
 
procedure TForm1.DoBmpProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  ProgressBar1.Position := PercentDone;
  Caption := Msg;
  Application.ProcessMessages;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
 
  BmpFile := ExtractFilePath(Application.exeName)+'CTP/OF17993wm_K.bmp';
 
  Bmp := TBitmap.Create;
  Bmp.OnProgress := DoBmpProgress;
 
  if ReadBitmapHeader(BmpFile, Bfh, Bih) then
    if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
      Bmp.LoadFromFile(BmpFile);
 
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
end;
 
end.

Je pense avoir reproduit votre source fidèlement.
La fiche ne s'affiche qu'après le chargement deu fichier
Progressebar ne se met évdemment pas à jour

**Dr.Who** · 15/12/2009, 00h23

c'est normal.

déplace le code de OnCreate dans l'evenement d'un boutton :

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
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
 
  Bmp := TBitmap.Create;
  Bmp.OnProgress := DoBmpProgress;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    if ReadBitmapHeader(BmpFile, Bfh, Bih) then
      if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
        Bmp.LoadFromFile(BmpFile);
end;

**colorid** · 15/12/2009, 01h17

J'ai placé un fichier bitmap de 400 Mo dans le chemin C:\Dossier\Fichier.BMP

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
unit Unit3;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;
 
type
  TForm3 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
    procedure DoBmpProgress(Sender: TObject; Stage: TProgressStage;
    PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
  public
    { Déclarations publiques }
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
function ReadBitmapHeader(const FileName: string; var aBFH: BITMAPFILEHEADER; var aBIH: BITMAPINFOHEADER): boolean;
begin
  result := false;
  with TFileStream.Create(FileName, fmOpenRead) do
  try
    read(aBFH, SizeOf(BITMAPFILEHEADER));
    read(aBIH, SizeOf(BITMAPINFOHEADER));
    result := true and (aBFH.bfType = $4D42);
  finally
    Free;
  end;
end;
 
var
  Bmp : TBitmap;
  Bfh : BITMAPFILEHEADER;
  Bih : BITMAPINFOHEADER;
  BmpFile : string;
 
procedure TForm3.Button1Click(Sender: TObject);
begin
  BmpFile := 'C:\Dossier\Fichier.bmp';
    if ReadBitmapHeader(BmpFile, Bfh, Bih) then
      if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
        Bmp.LoadFromFile(BmpFile);
end;
 
procedure TForm3.DoBmpProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
begin
  ProgressBar1.Position := PercentDone;
  Caption := Msg;
  Application.ProcessMessages;
end;
 
procedure TForm3.FormCreate(Sender: TObject);
begin
  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
  Bmp := TBitmap.Create;
  Bmp.OnProgress := DoBmpProgress;
end;
 
procedure TForm3.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
end;
 
end.

Le progressbar reste vierge
Mieux, en plaçant un point d'arret sur la ligne Caption := Msg; dans TForm3.DoBmpProgress Je m'aperçois que doBmpProgress n'est jamais appelée

**colorid** · 15/12/2009, 01h28

avec les deux procédures :

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
// retourne dans Wc et Hc les dimensions de BMP réduite pour s'afficher dans
// un Timage de dimension Wa, Ha
procedure ImageDimCible( BMP: TBitmap; Wa,Ha: Integer; var Wc,Hc: integer);
var
  Hi,Wi : Integer;
  Ri,Ra : Double;
begin
  // Dimensionnement proportionnel de l'image Bitmap
  Wi := BMP.Width;  // Largeur Bitmap initiale
  Hi := BMP.Height; // Hauteur Bitmap initiale
  Ri := Wi/Hi;         // Rapport Largeur/Hauteur initiale
  Ra := Wa/Ha;         // Rapport Largeur/Hauteur allouée
  if Ri>Ra then
  begin
    Hc := round(Hi*Wa/Wi);
    Wc := Wa;
  end
  else
  begin
    Hc := Ha;
    Wc := round(Wi*Ha/Hi);
  end;
end;
 
procedure DisplayImage( ImageShooted: TImage; BMPSource:TBitmap);
var
  W,H,Wc,Hc,x1,x2,y1,y2: Integer;
  IRect,ImgRect: TRect;
begin
  ImageShooted.Canvas.Pen.Color:= clWhite;
  IRect:= Rect(0,0,ImageShooted.Width,ImageShooted.Height);
  ImageShooted.Canvas.FillRect(IRect);
  // Dimensionnement proportionnel de l'image
  W:= ImageShooted.Width;
  H:= ImageShooted.Height;
  ImageDimCible( BMPSource,W,H,Wc,Hc);
  With ImageShooted.canvas do
  begin
    x1:= (W-Wc) div 2;
    y1:= (H-Hc) div 2;
    x2:= x1+Wc;
    y2:= y1+Hc;
    ImgRect:= Rect(x1,y1,x2,y2);
    StretchDraw(ImgRect,BMPSource);
  end;
end;

et en remplaçant la procedure Button1Click par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
procedure TForm3.Button1Click(Sender: TObject);
begin
  BmpFile := 'C:\Dossier\Fichier.bmp';
    if ReadBitmapHeader(BmpFile, Bfh, Bih) then
      if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
      begin
        Bmp.LoadFromFile(BmpFile);
        DisplayImage(Image1,BMP);
      end;
end;

L'image s'affiche dans Image1, ce qui prouve que le bitmap s'est correctement chargé

**Montor** · 15/12/2009, 11h36

l'événement onProgress ne fonctionnera pas il n'est pas utiliser en interne
pour l'affichage de l'image il y a surement une erreur dans l'entête du fichier bmp

**colorid** · 15/12/2009, 12h33

Qu'entendez-vous par En interne ?

**Montor** · 15/12/2009, 14h29

Qu'entendez-vous par En interne ?

tu ne peux pas l'utiliser
supprime tout les ligne contenant Bmp

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    if ReadBitmapHeader(BmpFile, Bfh, Bih) then
      if MessageDlg(format('Prés pour charger le fichie bitmap %.2nKo %dx%d',[Bfh.bfSize/1024, Bih.biWidth, Bih.biHeight]),
                  mtConfirmation, [mbOk, mbAbort], 0) = mrOk then
        Image1.Picture.LoadFromFile(BmpFile);
end;

TrackBar sur fonction LoadFromFile

Langage Delphi

Discussions similaires

Partager

Partager