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+
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+
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.
Merci pour cette info.
Mais comment lier la position de progressBar avec Onprogress et comment initaialiser Max et Min du TprogressBar Avant le loadFromFile ?
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.
La fonction de lecture de l'entête fichier fonctionne bien
Mais la
mais la progressbar ne se met pas à jour
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;
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;
Je pense avoir reproduit votre source fidèlement.
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.
La fiche ne s'affiche qu'après le chargement deu fichier
Progressebar ne se met évdemment pas à jour
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;
J'ai placé un fichier bitmap de 400 Mo dans le chemin C:\Dossier\Fichier.BMP
Le progressbar reste vierge
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.
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
avec les deux procédures :
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
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;
L'image s'affiche dans Image1, ce qui prouve que le bitmap s'est correctement chargé
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'é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
Qu'entendez-vous par En interne ?
tu ne peux pas l'utiliserQu'entendez-vous par En interne ?
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;
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager