Pb sur une image dans un Hint

[Bruno13]

Bonjour à tous,

Je cherche à afficher une image réduite dans un Hint. J'ai à l'origine une image PNG que je réduis dans une image BMP.
J'obtiens l'erreur EConvertError "Impossible d'affecter TBitmap à TControlCanvas" dans mon vtGetHintSize. Et même si je vire la ligne qui pose probleme (en gras dans le code), j'obtiens la meme erreur dans le vtDrawHint.

Quelqu'un peut-il m'aider ? D'avance merci

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
procedure TChild.vtGetHintSize(Sender: TBaseVirtualTree;  Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
var
  PR:   TPatClass;
  aBMP: TBitmap;
  aPNG: TPNGImage;
begin
  PR:=GetPointerFromTree(Sender, Node);
  if Assigned(PR) then
  begin
    case Column of
    0: if FileExists(Path+'\'+cPathPicture+'\'+PR.Number+'.png') then
    begin
      aBMP := TBitmap.Create;
      aPNG := TPNGImage.Create;
      try
        aPNG.LoadFromFile(Path+'\'+cPathPicture+'\'+PR.Number+'.png');
        aBMP.Width:=aPNG.Width div 10;
        aBMP.Height:=aPNG.Height div 10;
        R:=Rect(0,0,aBMP.Width,aBMP.Height);

        //Copie de l'image avec redimensionnement sur le canvas du TBitmap
        aBMP.Canvas.StretchDraw(R, aPNG);
        Canvas.Handle := THintWindow.Create(TVirtualDrawTree(Sender)).Canvas.Handle;
        Canvas.Assign(aBMP);

      finally
        aPNG.Free;
        aBMP.Free;
      end;

      InflateRect(R, +5, +5);
    end;
  end;
end; {* proc .vtGetHintSize *}

procedure TChild.vtDrawHint(Sender: TBaseVirtualTree;
  HintCanvas: TCanvas; Node: PVirtualNode; R: TRect; Column: TColumnIndex);
var
  PR:    TPatClass;
  aBMP: TBitMap;
  aPNG: TPNGImage;
begin
  PR:=GetPointerFromTree(Sender, Node);
  if Assigned(PR) then
  begin
    case Column of
      0: if FileExists(Path+'\'+cPathPicture+'\'+PR.Number+'.png') then
      begin
      aBMP := TBitmap.Create;
      aPNG := TPNGImage.Create;
      try
        aPNG.LoadFromFile(Path+'\'+cPathPicture+'\'+PR.Number+'.png');
        aBMP.Width:=aPNG.Width div 10;
        aBMP.Height:=aPNG.Height div 10;
        R:=Rect(0,0,aBMP.Width,aBMP.Height);

        //Copie de l'image avec redimensionnement sur le canvas du TBitmap
        aBMP.Canvas.StretchDraw(R, aPNG);
        HintCanvas.Assign(aBMP);
      finally
        aPNG.Free;
        aBMP.Free;
      end;
      InflateRect(R, +5, +5);
    end;
  end;
end; {* proc .vtDrawHint *}

[ShaiLeTroll]

J'ai aussi refait le Hint pour remplacer le texte par du HTML et aussi avoir un hint sur un composant en enabled à false, je laisse imaginer le mécanisme intrusif que cela peu amener ... et j'ai ajouté dans le hint des boutons images car j'ai fait ma propre classe mais pas dérivée de HintWindow (je conserve la standard pour le hint sur les menus et le debug puisque le hint standard affiche le code HTML du Hint HTML qui affiche le Formatage )

Donc, j'écrirais plutôt

Code :

THintWindow.Create(TVirtualDrawTree(Sender)).Canvas.CopyRect(Rect(0, 0, ..., ...,), aBMP.Canvas, Rect(0, 0, ..., ...,) );

[Bruno13]

Bonjour,

Pourrais-tu me donner un peu plus de détails car je ne sais pas ce que je dois faire avec ta ligne ?

Dois-je l'affecter comme ceci :

Code :

Canvas.Handle:= THintWindow.Create(TVirtualDrawTree(Sender)).Canvas.CopyRect(R, aBMP.Canvas, R );

Biensûr avec :

Code :

R:=Rect(0,0,aBMP.Width,aBMP.Height);

Mais le type attend un HDC donc est-ce que cette ligne est complête ?

Merci pour ton aide.
Dans l'attente de te lire

[ShaiLeTroll]

Je n'ai pas fait d'affectation mais un appel de la méthode CopyRect qui recopie le dessin contenu dans aBMP.Canvas vers le HintWindow.Canvas ... j'ignore si cela fonction, mais en tout cas entre BMP.Canvas vers Icon.Canvas cela va parfaitement ...

[Bruno13]

Désolé cela ne semble pas fonctionner mais il est fort probable que je n'ai pas tout saisie dans ce que tu me dis.

D'autres idées ?

[Gilbert Geyer]

Si cela peut te donner des idées voiçi un bout de code qui permet d'insérer un Bmp dans un Hint (mais sans modifier la police de caractères) :

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
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
81
82
HINT + Icone Bmp
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, shellapi;
 
type
  TForm1 = class(TForm)
  ...
  procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
  TMyHintWindow = class(THintWindow)
  private
    ABitmap: TBitmap;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TMyHintWindow;
  ShowHint := true;
  Hint := '    Une image dans une info-bulle..'
end;
 
constructor TMyHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  ABitmap:= TBitmap.Create;
  try
    ABitmap.LoadFromFile('popo.bmp');
    ABitmap.Transparent := true;
  except
    FreeAndNil(ABitmap);
  end;
end;
 
destructor TMyHintWindow.Destroy;
begin
  ABitmap.Free;
  inherited;
end;
 
procedure TMyHintWindow.Paint;
var  DC: HDC;
     R: TRect;
begin
 
  if Assigned(ABitmap) then
     Canvas.Draw(1, 2, ABitmap);
 
  inherited;
 
  DC := GetWindowDC(Handle);
  try
    R := Rect(0, 0, Width, Height);
    DrawEdge(DC, R, EDGE_ETCHED , BF_RECT + BF_MONO);
  finally
    ReleaseDC(Handle, DC);
  end;
 
end;
 
end.

[sovitec]

Je voulais aussi vous signaler qu'il existe un composant Jedi (JvBalloonHint) qui permet, entre autre, d'afficher un bmp dans un hint.

[cincap]

Bonjour à toutes et à tous,

Je sais que ce topic date, mais c'est toujours interessant de comprendre plus loin ce code !

@ Gilbert Geyer, petite question, avec ton astuce, peut on définir la hauteur et largeur du hint par exemple 64x48 qui sont les dimensions de ma photo.

En te remerciant,

@+,

Cincap

[Gilbert Geyer]

Bonjour,

A Cincap :

peut on définir la hauteur et largeur du hint par exemple 64x48 qui sont les dimensions de ma photo.

Oui, c'est faisable j'ai essayé, il suffit d'ajouter la ligne en gras-vert ci-dessous :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TMyHintWindow.Paint;
var  DC: HDC;
     R: TRect;
begin

  if Assigned(ABitmap) then
     Canvas.Draw(1, 2, ABitmap);

  inherited;

  DC := GetWindowDC(Handle);
  try
    Height:=ABitmap.Height; //<<
    R := Rect(0, 0, Width, Height);
    DrawEdge(DC, R, EDGE_ETCHED , BF_RECT + BF_MONO);
  finally
    ReleaseDC(Handle, DC);
  end;

end;

Mais il faut également ajouter un nombre d'espaces suffisant à gauche du texte du Hint sinon le texte passe sur le dessin.

A+.

[cincap]

@ Gilbert Geyer, bonsoir, c'est complètement génial, j'avais une autre source beaucoup plus volumineuse à mettre en oeuvre.

J'avais aussi fait plus simple (faux hint !) en affichant un Tpanel contenant un Timage qui affichait un jpg créé provisoirement uniquement au survol du Tbutton et en revenant sur le Tform, le Tpanel n'était plus visible.

Merci encore pour cette solution et ton aide.

Edit : cela fonctionne aussi avec un Jpg, c'est génial.

@+,

Cincap

[cincap]

Bonjour à toutes et à tous,

Pour ceux que cela intéresse on ne sait jamais, pour mon usage personnel, je devais charger une image Jpg de 640 x 480 créée temporairement à l'exécution de la fiche afin de faire un test d'envoi par Email avec attache.

Et sur le bouton de test, afficher un hint avec cette image mais avec forcément un resize.

J'ai donc remanié l'excellent code de Gilbert G. pour le faire.

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
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 
unit Unit1;
 
interface
 
uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, shellapi, Jpeg, Menus, Buttons, ComCtrls;
 
type
    TForm1 = class(TForm)
    BTest: TButton;
 
  procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
  TMyHintWindow = class(THintWindow)
  private
    JPG : TJPegImage;
    Bmp,bmpbis: Tbitmap;
    BMPLoaded : boolean;
    NewW, NewH, OldSBM: Integer;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure JPEGToBMP(JPG : TJPegImage; BMP : TBitmap);
begin
  BMP.Width := JPG.Width;
  BMP.Height:= JPG.Height;
  BMP.PixelFormat := pf24bit;
  BMP.Canvas.Draw(0,0,JPG);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HintWindowClass := TMyHintWindow;
  ShowHint := true;
  BTest.Hint := ' ' ;
end;
 
constructor TMyHintWindow.Create(AOwner: TComponent);
begin
 
  inherited;
 
  BMPLoaded := false;
 
  { creation du Jpg temporaire }
  jpg:= TJPEGImage.Create;
 
  { creation du bitmap temporaire }
  bmp:=Tbitmap.Create;
 
  { creation du bitmap bis temporaire }
  bmpbis:=Tbitmap.Create;
 
  try
  { Chargement de l'image jpg }
  jpg.loadFromFile('C:\Hint640x480.jpg');
 
  { convertion JPG > BMP }
  JPEGToBMP(JPG,BMP);
 
  { BMP est prét }
  BMPLoaded := true;
 
  { si BMP est prét }
  if BMPLoaded then
  begin
 
  NewW := 160; //Dimensions width du Hint
  NewH := 130; //Dimensions height du Hint
 
  end;
 
        { enfin on va injecter Bmp dans le bitmap de bmpbis}
        with bmpbis do
        begin
 
          { on definit les nouvelles dimensions }
          width       := NewW ;
          height      := NewH;
 
          { on travail en couleurs 24bpc }
          pixelformat := pf24bit;
 
          { on sauvegarde l'ancien mode de redimension du canvas }
          OldSBM := GetStretchBltMode(Canvas.Handle);
 
          { et on le definit en mode HALFTONE }
          SetStretchBltMode(Canvas.Handle, HALFTONE);
 
          { on dessine l'image }
          StretchBlt( Canvas.Handle, 0, 0, NewW, NewH,
                      bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
                      SRCCOPY);
 
          { on restaure le mode de redimensionnement du canvas }
          SetStretchBltMode(Canvas.Handle, OldSBM);
 
          { on assigne }
          jpg.Assign(bmpbis);
 
         end;
  except
    FreeAndNil(jpg);
    FreeAndNil(bmp);
    FreeAndNil(bmpbis);
  end;
end;
 
destructor TMyHintWindow.Destroy;
begin
  bmp.Free;
  bmpbis.free;
  jpg.Free;
  inherited;
end;
 
procedure TMyHintWindow.Paint;
var  DC: HDC;
     R: TRect;
begin
 
  if Assigned(jpg) then
     Canvas.Draw(1, 2, jpg);
 
  inherited;
 
  DC := GetWindowDC(Handle);
  try
 
    Height:=jpg.Height;
    width:=jpg.width;
    R := Rect(0, 0, Width, Height);
    DrawEdge(DC, R, EDGE_ETCHED , BF_RECT + BF_MONO);
  finally
    ReleaseDC(Handle, DC);
  end;
 
end;
 
end.

@+,

Cincap

[Gilbert Geyer]

Bonjour,

A Cincap :

cela fonctionne aussi avec un Jpg, c'est génial.

... Tu peux également le faire fonctionner avec des *.DIB, *.GIF, *.ICO, *JIF, *.WMF, *.EMF en plus des *.BMP et *.JPG, en modifiant ton JPEGToBMP() à partir du code suivant :

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
uses Windows, Classes, Forms, Graphics, Sysutils, Dialogs, extdlgs,
     extctrls, Jpeg,  Messages, Controls, Math,
     axCtrls; //<- pour TOleGraphic;


implementation

function  BMPdeIMG(const nomFichierImg : string) : tBitMap;
const     FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var       OleGraphic: TOleGraphic; FS: TFileStream; ext : string; img : tImage;
begin     if not FileExists(nomFichierImg) then begin
             showMessage(nomFichierImg+' : n''existe pas'); Result:=nil; EXIT;
          end;
          ext:=UpperCase(ExtractFileExt(nomFichierImg));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin showMessage(ext+' = Format non supporté par BMPdeIMG');
                Result:=nil; EXIT;
          end;
          if ext='.BMP' then begin
             Result :=tBitmap.create;
             Result.PixelFormat:=pf24Bit;
             Result.LoadFromFile(nomFichierImg);
             EXIT;
          end;
          OleGraphic := TOleGraphic.Create;
          FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
          img:= tImage.Create(Application);
          try
             OleGraphic.LoadFromStream(FS);
             img.Picture.Assign(OleGraphic);
             Result :=tBitmap.create;
             with Result do
             begin PixelFormat:=pf24Bit;
                   Width :=img.Picture.Width;
                   Height:=img.Picture.Height;
                   Canvas.Draw(0, 0, img.Picture.Graphic);
             end;
          finally
             fs.Free;
             img.free;
             OleGraphic.Free;
          end;
end; // BMPdeIMG

A+.

[cincap]

Bonsoir,

@ Gilbert Geyer, j'ai testé ta fonction pour les différents formats, j'ai bien le cadre du hint avec les dimensions correctes mais vide (sans image).

Je suppose que j'utilise mal ta fonction, au départ dans mon cas, je charge un Jpg de 640x480.

Code :

1
2
 
 BMPdeIMG('C:\Hint2.jpg');

@+,

Cincap

[Gilbert Geyer]

Bonjour,

A Cincap :

Je suppose que j'utilise mal ta fonction, au départ dans mon cas, je charge un Jpg de 640x480.

Code : BMPdeIMG('C:\Hint2.jpg');

... bigre !!! Une fonction ça s'utilise comme ça :

Code :

1
2
3
var   MonBitMap : tBitMap;
...
MonBitMap:=BMPdeIMG('C:\Hint2.jpg'); ... Non ???

Comme le tBitmap.Create est réalisé à l'intérieur de BMPdeIMG, ne pas oublier de faire par la suite un MonBitMap.Free.

A+.

[cincap]

Bonjour à toutes et à tous,

@ Gilbert Geyer, en effet tu as raison, j'avais d'abord testé avec :

Code :

1
2
 
Bmpbis:=BMPdeIMG('C:\Hint2.jpg');

Sans succès alors que j'aurai du faire :

Code :

1
2
 
Bmp:=BMPdeIMG('C:\Hint2.jpg');

Puisque c'était mon TBitmap temporaire.

Par contre et c'est normal avec ta solution, dans mon cas bien précis, j'avais besoin d'avoir un hint avec image sur un seul Tbutton celui de test et pas sur les autres Tbutton qui sont sur la fiche.

Pense tu qu'il y aurait moyen de différencier les Tbutton soit par la propriété Tag ?

J'ai testé pas mal de solutions sans succès.

Encore merci pour cette excellente solution.

@+,

Cincap

[Gilbert Geyer]

Re-bonjour,

A Cincap :

j'avais besoin d'avoir un hint avec image sur un seul Tbutton celui de test et pas sur les autres Tbutton qui sont sur la fiche.

Pense tu qu'il y aurait moyen de différencier les Tbutton soit par la propriété Tag ?

Comme la procedure TMyHintWindow.Paint est surchargée on ne peut pas y récupérer directement le tag d'un Sender: TObject, mais on peut contourner ce problème comme suit en passant par une variable globale en fonction de laquelle on utilisera soit le Hint avec image soit un Hint normal sans image :

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
var       Tagada : integer;

procedure TMyHintWindow.Paint;  
var       DC: HDC;
          R: TRect;
begin
          if Assigned(ABitmap) and (Tagada=0)
          then Canvas.Draw(1, 2, ABitmap); //<- Hint avec image

          inherited;

          DC := GetWindowDC(Handle);
          try
            if Tagada=0 then Height:=ABitmap.Height             //<- Hint avec image
                        else Height:=Canvas.TextHeight('H')+6;  //<- Hint normal sans image
            R := Rect(0, 0, Width, Height);
            DrawEdge(DC, R, EDGE_ETCHED , BF_RECT + BF_MONO);
          finally
            ReleaseDC(Handle, DC);
          end;

end;

procedure TForm1.SpeedButton1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
          Tagada:=1;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
          Tagada:=0;
end;

Et si tu as besoin d'un nombre élevé de Boutons avec un Hint normal tu peux dans l'Inspecteur d'objets faire pointer leur MousMove
sur la procedure TForm1.SpeedButton1MouseMove.

A+.

[cincap]

@ Gilbert Geyer, formidable !

Cela correspond à mes attentes, ce code est à garder précieusement.

Merci de ton aide précieuse à tous et de tes explications.

@+,

Cincap

[Gilbert Geyer]

Re-Bonjour,

De rien, ce fût un plaisir.

A+.

[cincap]

Bonsoir à toutes et à tous,

Dans le déroulement de ce topic, j'avais parlé d'utiliser un effet de hint sur un TButton avec un TPanel (p1), un TImage (hint1) propriété "Stretch" à true et un TButton (Bexit).

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
 
var
  Form1: TForm1;
  chappli : String;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.BexitMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  p1.Left:=BExit.Left+(X-p1.Width div 2);// Je positionne le Hint.
 
  p1.Visible:= true;
end;
 
procedure TForm1.BexitClick(Sender: TObject);
begin
  Beep;
  Application.Terminate;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  p1.Visible:=false;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;// Evite le scintillement.
 
  chappli := ExtractFilePath(Application.ExeName);
 
  hint1.Picture.LoadFromFile(chappli +'hint.jpg');  
 
end;

Naturellement fort simple !

@+,

Cincap

[Gilbert Geyer]

Bonjour,

C'est effectivement une parade très simple.

A+.