Discussion :

[KlausGunther]

Je suis sous W11 avec Delphi 6 Personal Edition.

Je travaille sur un contrôle composé contenant un TPicture et un TPanel.
Je veux charger un fichier BMP dans le TPicture, puis afficher l'image dans le canvas du TPanel.

Le chargement du fichier par LoadFromFile ne pose pas de problème.
J'utilise une version dérivée de TPanel afin d'avoir accès à la méthode Paint du panel.
Là, j'utilise CopyRect sur ce canvas pour y déposer la bitmap chargée dans le TPicture.

La difficulté est de savoir QUAND l'opération de chargement du fichier est terminée et la bitmap est disponible pour la méthode Canvas.CopyRect sur le panel.

Si je fais un délai de 500 ms entre le LoadFromFile et le CopyRect, l'image s'affiche sans problème.
Sans ce délai, l'image ne s'affiche pas - manifestement, la bitmap n'est pas encore disponible.

J'ai utilisé l'évènement OnChange du TPicture dans lequel j'appelle la méthode Paint du panel dérivé, dans laquelle je fais le CopyRect sur le canvas.

L'évènement se déclenche bien, mais apparemment, il se déclenche dès que le LoadFromFile commence au lieu de se déclencher lorsque l'opération est terminée.
Et donc, même dans ce cas, la bitmap n'est pas disponible.

Question: comment savoir quand l'opération LoadFromFile est terminée ?

A tout hasard, voici les parties significatives du code:

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
 
type TKPicture = class
  private
    fOwner: TComponent;
    fPicture: TPicture;
    fPanel: TKPanel;
    fTag: integer;
    procedure PictureChanged(Sender: TObject);
  published
    constructor CreateNew(aOwner: TComponent; aDest: HWND);
    destructor Destroy; override;
    property Tag: integer read fTag write fTag;
    property Owner: TComponent read fOwner write fOwner;
 
    procedure Localize(aX, aY, aW, aH: integer);
    procedure LoadPicture(aFile: string);
end;
 
constructor TKPicture.CreateNew(aOwner: TComponent; aDest: HWND);
begin
  inherited;
  Owner := aOwner;
  Tag := 0;
  fOwner := aOwner;
  fPicture := TPicture.Create;
  fPicture.OnChange := PictureChanged;
  fPanel := TKPanel.Create(aOwner);
  fPanel.Tag := integer(self);
  fPanel.ParentWindow := aDest;
end;
 
destructor TKPicture.Destroy;
begin
  Tag := 0;
  fPanel.Free;
  fPicture.Free;
  inherited;
end;
 
procedure TKPicture.Localize(aX, aY, aW, aH: integer);
begin
  fPanel.Left := aX;
  fPanel.Top := aY;
  fPanel.Width := aW;
  fPanel.Height := aH;
end;
 
procedure Delay(Milliseconds: Integer);
  {by Hagen Reddmann}
var
  Tick: DWORD;
  Event: THandle;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWORD(Milliseconds);
    while (Milliseconds>0) and (MsgWaitForMultipleObjects(1,Event,False,Milliseconds,QS_ALLINPUT)<>WAIT_TIMEOUT) do begin
      Application.ProcessMessages;
      Milliseconds := Tick - GetTickCount;
    end;
  finally
    CloseHandle(Event);
  end;
end;
 
procedure TKPicture.LoadPicture(aFile: string);
begin
  fPicture.LoadFromFile(aFile);
//  Delay(500);                   // **1  avec ce délai, l'image s'affiche lors de l'évènement PictureChanged
//  fPanel.Paint;                  // **2 et même sans déclarer l'écènement PictureChanged, le Paint ici affiche l'image di le délai a été fait
end;
 
procedure TKPicture.PictureChanged(Sender: TObject);
begin
  fPanel.Paint;  
end;

J'affiche bien l'image si j'active la ligne **1.
En l'état, l'image ne s'affiche pas, malgré le déclenchement de PictureChanged.

J'aimerais bien pouvoir me passer de cette procédure Delay et faire mon Paint au moment opportun.
Comment savoir si la bitmap du TPicture est prête ?
En fait, la question se résume à ceci: comment être averti que l'opération LoadFromFile est terminée ?

[XeGregory]

Test avec Invalidate plutôt que d’appeler Paint directement. Invalidate demande au VCL de redessiner proprement au bon moment.

Code :

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

1
2
3
4
5
procedure TKPicture.LoadPicture(aFile: string); 
begin 
  fPicture.LoadFromFile(aFile); // synchrone 
  fPanel.Invalidate; // demande le redraw 
end;

Code :

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

1
2
3
4
procedure TKPicture.PictureChanged(Sender: TObject);
begin 
  fPanel.Invalidate; 
end;

[Papy214]

Vcl.Graphics.TGraphic.OnProgress

Je n'ai pas de Delphi installé en ce moment mais cet event ne donnerait il pas la solution ?

[KlausGunther]

Test avec Invalidate plutôt que d’appeler Paint directement. Invalidate demande au VCL de redessiner proprement au bon moment.

Code :

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

1
2
3
4
5
procedure TKPicture.LoadPicture(aFile: string); 
begin 
  fPicture.LoadFromFile(aFile); // synchrone 
  fPanel.Invalidate; // demande le redraw 
end;

Code :

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

1
2
3
4
procedure TKPicture.PictureChanged(Sender: TObject);
begin 
  fPanel.Invalidate; 
end;

Merci d'avoir regardé mon problème !

J'avais essayé cette solution.
Invalidate après LoadFromfile détecte bien que la bitmap n'est pas encore disponible et... ne fait donc rien.
Invalidate dans la procédure PictureChanged a le même biais - cet évènement est déclenché au début de LoadFromFile, pas à la fin.
Et donc agit comme dans le cas précédent - rien n'est fait puisque la bitmap n'est pas encore disponible.

Il faudrait trouver un moyen de savoir quand le chargement de la bitmap est terminé - de préférence par un évènement.
Car le contournement avec Delay fonctionne, mais ce n'est pas satisfaisant - un blocage inutilement long dans des cas de petites images, et trop court dans le cas de grosses images.

[XeGregory]

Il faudrait trouver un moyen de savoir quand le chargement de la bitmap est terminé

Code :

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

1
2
3
4
5
6
7
procedure PanelPaint(Sender: TObject);
begin
  if Assigned(MyTKPicture.fPicture.Graphic) then
    (Sender as TPanel).Canvas.StretchDraw(
      Rect(0,0,(Sender as TPanel).Width,(Sender as TPanel).Height),
      MyTKPicture.fPicture.Graphic);
end;

[KlausGunther]

Code :

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

1
2
3
4
5
6
7
procedure PanelPaint(Sender: TObject);
begin
  if Assigned(MyTKPicture.fPicture.Graphic) then
    (Sender as TPanel).Canvas.StretchDraw(
      Rect(0,0,(Sender as TPanel).Width,(Sender as TPanel).Height),
      MyTKPicture.fPicture.Graphic);
end;

Je vois - on teste, avant de peindre, si la bitmap est disponible.
Mais cela ne déclenche pas le paint lorsque le LoadFromFile a terminé - cela empêche juste de peindre si la bitmap est incomplète.

J'ai trouvé l'évènement OnProgress qui pourraot constituer une solution: déclencher le Paint lorsque la progression atteint 100 % ou lorsque l'état d'avancement indique "complet".

J'ai fait ceci:

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
constructor TKPicture.CreateNew(aOwner: TComponent; aDest: HWND);
begin
  inherited;
  Owner := aOwner;
  Tag := 0;
  fOwner := aOwner;
  fPicture := TPicture.Create;
  fPicture.OnChange := PictureChanged;
  fPicture.OnProgress := Progress;
  fPanel := TKPanel.Create(aOwner);
  fPanel.Tag := integer(TKPanelTag.Createnew(ptPicture,self));   
  fPanel.ParentWindow := aDest;
end;
 
procedure TKPicture.Progress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte;  RedrawNow: Boolean; const R: TRect;
      const Msg: string);
begin
showmessage(inttostr(PercentDone)+' %');
end;

Sauf que lors du LoadFromFile, la procédure Progress n'est jamais appelée - j'ai dû manquer quelque chose.

[XeGregory]

On crée l’instance graphique correspondant à l’extension, on lui attache OnProgress, on charge le fichier dans cette instance puis on l’assigne à fPicture. Le gestionnaire Progress surveille PercentDone = 100 ou Stage = psEnd pour déclencher le Paint.

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
constructor TKPicture.CreateNew(aOwner: TComponent; aDest: HWND);
begin
  inherited Create(aOwner);
  Owner := aOwner;
  Tag := 0;
  fOwner := aOwner;
  fPicture := TPicture.Create;
  fPicture.OnChange := PictureChanged;
  fPanel := TKPanel.Create(aOwner);
  fPanel.Tag := Integer(TKPanelTag.CreateNew(ptPicture, Self));
  fPanel.ParentWindow := aDest;
end;
 
procedure TKPicture.LoadFromFileWithProgress(const AFileName: string);
var
  Ext: string;
  G: TGraphic;
begin
  Ext := LowerCase(ExtractFileExt(AFileName));
  if Ext = '.jpg' then
    G := TJPEGImage.Create
  else if Ext = '.jpeg' then
    G := TJPEGImage.Create
  else if Ext = '.png' then
    G := TPngImage.Create
  else if Ext = '.bmp' then
    G := TBitmap.Create
  else
    raise Exception.CreateFmt('Format non supporté : %s', [Ext]);
 
  try
    // Attacher l'événement de progression à l'instance réelle
    // Certaines classes (TJPEGImage) appellent OnProgress pendant LoadFromFile
    G.OnProgress := Progress;
 
    // Charger le fichier dans l'instance graphique
    G.LoadFromFile(AFileName);
 
    // Transférer dans TPicture (déclenchera OnChange)
    fPicture.Assign(G);
  finally
    G.Free;
  end;
end;
 
procedure TKPicture.Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  // Déclencher Paint quand terminé
  if (Stage = psEnd) or (PercentDone = 100) or SameText(Msg, 'Complete') then
  begin
    if Assigned(fPanel) then
      fPanel.Invalidate;
  end;
end;

[Andnotor]

Que PictureChanged soit appelé en début de chargement en D6 serait très surprenant. Tu as contrôler les sources ?

[...] rien n'est fait puisque la bitmap n'est pas encore disponible.

Qu'est-ce qui te permet d'affirmer cela ? fPicture.Bitmap.HandleAllocated renvoie FALSE ?

J'ai plutôt l'impression que ce chargement arrive trop tôt, que la cible n'est pas prête à recevoir des commandes (mais le code montré ne permet pas de le déterminer).
Ce qui me fait penser ça est que MsgWaitForMultipleObjects est signalé sur réception d'un message suivi ici du vidage de la pile, ce qui pourrait permettre la fin de son initialisation.

Est-ce que l'image s'affiche si tu remplaces Delay(500) par Sleep(500) ? je parierais que non !
Est-ce que l'image s'affiche si Delay(500) est placé avant LoadFromFile ? je parierais que oui !

[KlausGunther]

Que PictureChanged soit appelé en début de chargement en D6 serait très surprenant. Tu as contrôler les sources ?

Qu'est-ce qui te permet d'affirmer cela ? fPicture.Bitmap.HandleAllocated renvoie FALSE ?

J'ai plutôt l'impression que ce chargement arrive trop tôt, que la cible n'est pas prête à recevoir des commandes (mais le code montré ne permet pas de le déterminer).
Ce qui me fait penser ça est que MsgWaitForMultipleObjects est signalé sur réception d'un message suivi ici du vidage de la pile, ce qui pourrait permettre la fin de son initialisation.

Est-ce que l'image s'affiche si tu remplaces Delay(500) par Sleep(500) ? je parierais que non !
Est-ce que l'image s'affiche si Delay(500) est placé avant LoadFromFile ? je parierais que oui !

1. Je suis certain que Picturechanged est appelé dès que LoadFromFile est lancé, sans attendre la fin de cette opération.
Comment ? C'est simple: afficher un message dans PictureChanged permet de voir que l'image n'est pas encore affichée et reste absente après fermeture de ce message.
Par contre, faire Delay(500) après LoadFromFile provoque l'affichage de l'image, alors qu'on a encore le message à l'écran.

2. Je n'ai pas essayé avec Sleep - je voulais être sûr que les évènements continuent à être traités correctement. J'ai pris la procédure Delay sur le net.

3. Placer Delay(500) devant LoadFromFile ne fait évidemment absolument rien, car le problème se situe après LoadFromFile.

4. un point étrange à souligner: la méthode Paint permet d'afficher la bitmap si elle est chargée complètement, mais la méthode Invalidate est inopérante !

5. Je ne peux pas regarder dans les sources de Delphi ! la version D6 Personal Edition ne comprend pas les sources, seulement les DCU...

Je joins un fichier ZIP qui contient le projet global avec sources et exécutables.
C'est une petite partie d'un projet plus vaste visant à obtenir un composant dérive de TStringGrid, mais avec de multiples fonctions supplémetaires.
Une de ces fonctions supplémentaires est la possibilité de fusionner un rectangle de cellules en une seule cellule. Et cette cellule de fusion pourra slors recevoir un texte multi-lignes, ou un contrôle injecté du genre TMemo, ou justement une grande image. Et c'est ce contexte que je suis en train d'explorer.

Le projet global est encore en cours de développement, bien que de vastes parties fonctionnent déjà. Le projet consiste en 2 parties:
-DllStringGrid.dll = implémentation de mon objet TKStringGrid et ses objets annexes, plus une interface appelable par un programme externe (orienté Panoramic)
-Test_KGFStringGrid.exe = programme de test et de démo, communiquant avec DllStringGrid.dll via l'interface mentionné ci-dessus

Pour mettre le problème actuel en évidence, il faut:
- lancer Test_KGFStringGrid.exe
- cliquer sur le bouton "Test special components" ==> ouverture d'une fenêtre entièrement générée par code, permettant de tester des composants spécifiques.
- cliquer sur "Create TKPicture" ==> une image avec une tête de tigre apparaît
- cliquer sur "Delete TKPicture" ==> cette image disparaît
- cliquer sur "Create XeGregory TKPicture" ==> un panel vide apparaît, l'image de la tête de tigre n'apparaît pas

"Create TKPicture" utilise Delay(500) après LoadFromFile et avant Paint
"Create XeGregory TKPicture" utilise le code proposé par XeGregory pour charger le fichier en utilisant l'évènement OnProgress mais qui n'est jamais appelé

Provisoirement, je peux continuer à progresser dans mon travail, puisque j'ai une version "qui marche" (avec Delay) pour afficher mon image.
Je reste cependant sur ma fin dans ma quête d'un avertissement de fin de chargement du fichier.
Je cherche quelque chose du genre OnCompletion ou similaire...

[Invité]

Deux erreurs fatales dans la déclaration de TKPanel les deux méthodes Paint et Create sont virtuelles et doivent être appeler avec override

Code :

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

1
2
3
4
5
6
7
8
type TKPanel = class(TCustomPanel)
  private
  protected
      procedure Paint;override;
  published
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
end;

* ce n'est pas la première fois que je vois que tu déclares le constructeur sans override dans tes exemples

[KlausGunther]

Deux erreurs fatales dans la déclaration de TKPanel les deux méthodes Paint et Create sont virtuelles et doivent être appeler avec override

Code :

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

1
2
3
4
5
6
7
8
type TKPanel = class(TCustomPanel)
  private
  protected
      procedure Paint;override;
  published
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
end;

* ce n'est pas la première fois que je vois que tu déclares le constructeur sans override dans tes exemples

Merveilleux ! Avec "override" aux deux endroits que tu as proposés, les deux versions de chargement d'image fonctionnent - à la fois celle avec on Delay comme avant, mais également celle proposée par XeGregory avec l'utilisation de OnProgress sur le LoadFromFile.

D'ailleurs, à ce sujet, j'ai trouvé la raison pour laquelle mon compilateur refusait le psEnd dans le traitement du OnProgress: cela aurait dû être psEnding.
Cela mis à part, la solution de XeGregory marche parfaitement, après correction de mon bug relevé par Mist2024.

Un grand MERCI à tous ceux qui ont bien voulu regarder mon code !

Je confesse être trop dilettant car simple auto-didacte dans mon temps libre, mais je promets d'approfondir l'aspect des méthodes virtuelles et le sens de override dans ce contexte.

[Papy214]

Ce serait bien d'ajouter la méthode à la FAQ

[der§en]

Il serait intéressant aussi d’expliquer que « « sleep » devrait être banni de nos sources, tout comme « synchronize » d’ailleurs…

[Papy214]

Il serait intéressant aussi d’expliquer que « « sleep » devrait être banni de nos sources, tout comme « synchronize » d’ailleurs…

Je comprends pour sleep mais pourquoi Synchronize ?

[SergioMaster]

Même réaction que papy214, je ne comprends pas cette ostracisation de synchronize, comment dans ce cas utiliser des threads nécessitants des mises à jour de l'UI ?

[der§en]

Je préféré utiliser TThread.Queue qui a la différence de Synchronize n’est pas bloquant…

Est Sleep est remplacé par TEvent, plus souple !

[Invité]

mais je promets d'approfondir l'aspect des méthodes virtuelles et le sens de override dans ce contexte.

Dans chaque class les méthodes virtuelles sont placées dans une table partagée utilisée par les ancêtres et les descendants et lorsque override est appelé sur une méthode on demande de remplacer la référence de cette méthode par la nouvelle.

Tu as eu mois de problème avec override omis sur le constructeur car les contrôles sont crées explicitement en appelant directement le class TButton et c'est extrêmement rare qu'un constructeur virtuel est utilisé essentiellement dans les metaclass .

Exemple qui appelle le constructeur virtuel.le code crée une copie d'un contrôle sur la même fiche.
Essaie et vérifie si le contrôle est copié correctement

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
type TClassOfControl = class of TControl;
 
procedure CopyControl(AControl: TControl);
var
 vClass: TClassOfControl;
 Fs: TMemorystream;
 NewControl: TControl;
begin
  vClass :=  TClassOfControl(AControl.ClassType);
  Fs:= TMemorystream.Create;
  try
      NewControl := vClass.Create(AControl); // constructeur virtuel appelé
      NewControl.Parent := AControl.Parent;
      Fs.WriteComponent(AControl);
      Fs.Position := 0;
      Fs.ReadComponent(NewControl);
  finally
    Fs.Free;
  end;
  NewControl.Top := NewControl.Top+20;
  NewControl.Left := NewControl.Left+20;
end;

[KlausGunther]

Dans chaque class les méthodes virtuelles sont placées dans une table partagée utilisée par les ancêtres et les descendants et lorsque override est appelé sur une méthode on demande de remplacer la référence de cette méthode par la nouvelle.

Tu as eu mois de problème avec override omis sur le constructeur car les contrôles sont crées explicitement en appelant directement le class TButton et c'est extrêmement rare qu'un constructeur virtuel est utilisé essentiellement dans les metaclass .

Exemple qui appelle le constructeur virtuel.le code crée une copie d'un contrôle sur la même fiche.
Essaie et vérifie si le contrôle est copié correctement

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
type TClassOfControl = class of TControl;
 
procedure CopyControl(AControl: TControl);
var
 vClass: TClassOfControl;
 Fs: TMemorystream;
 NewControl: TControl;
begin
  vClass :=  TClassOfControl(AControl.ClassType);
  Fs:= TMemorystream.Create;
  try
      NewControl := vClass.Create(AControl); // constructeur virtuel appelé
      NewControl.Parent := AControl.Parent;
      Fs.WriteComponent(AControl);
      Fs.Position := 0;
      Fs.ReadComponent(NewControl);
  finally
    Fs.Free;
  end;
  NewControl.Top := NewControl.Top+20;
  NewControl.Left := NewControl.Left+20;
end;

J'ai essayé. Oui, cela copie correctement le contrôle, à l'exception des évènements programmés (Onclick, ...). Mais en ajoutant cela manuellement, tout fonctionne.
Je vais regarder cela en détail...

J'ai trouvé cet article: https://docwiki.embarcadero.com/RADS...hodes_(Delphi)
Je vais regarder cela attentivement. J'avoue que pour le moment, je fais cela un peu "intuitivement", en dilettante justement. Mais je vais approfondir.
Merci de me pousser dans ce sens !