Discussion :

[Bruno13]

Bonjour,

Est-il possible d'avoir un effet de transparence sur un TPanel ?
Je ne trouve pas le AlphaBlend.

Où alors que puis-je utiliser d'autre dans le cadre où je me sers d'un TPanel pour afficher comme un Hint avec du texte à l'intérieur ?

Merci pour vos réponses,

Bruno

[Charly910]

Bonjour,

je crois que ce n'est pas possible avec le Panel.

Tu as le Bevel dans l'onglet supplément, mais ce n'est pas un container, c'est juste un cadre (mais il est transparent)

Cordialement

Charly

[Andnotor]

Je créerais plutôt le Hint avec une fiche indépendante, sans bordure, fsStayOnTop, etc.

[Bruno13]

Bonjour,

Merci pour vos réponses mais concernant l'utilisation d'une fiche n'est-ce pas un peu trop lourd dans la gestion ??? et surtout pour un hint qui doit s'afficher régulièrement ??

[Archimède]

Une simple paintbox... si tu ne remplis pas, elle prend le fond de la fiche...
ci-joint :

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
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
with paintbox1.canvas do begin
                         font.Size:=20;
                         font.Color:=clred;
                         TextOut(0,0,'hint');
                         end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
lleft:=paintbox1.Left;
ttop:=paintbox1.Top;
bool:=true;
xo:=x;
yo:=y;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if bool then begin
paintbox1.Left:=lleft+x-xo;
paintbox1.top:=ttop+y-yo;
end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
bool:=false;
end;

là, je déplace le message à la souris sur la form en conservant le fond de la fiche

[Archimède]

le hic, c'est qu'elle n'est pas ontop sur les autres contrôles...
dommage, c'est raté...sur le coup, je n'ai pas pensé à ça bien que ce soit évident. excuse...désolé, c'était une idée dans l'instant.

[Andnotor]

C'est certainement plus "lourd" qu'un panel (en terme de resources), mais autrement plus souple à la réutilisation si tu as plusieurs fiches, projets, etc.

[Gilbert Geyer]

Bonjour,

Pour imiter un simple Hint le moins lourd est d'utiliser un TLabel qui possède la propriété transparent.

A+

[Bruno13]

Bonjour Gilbert,

Humm, cela aurait pu être une bonne idée mais hélas je ne veux pas le fond totalement transparent mais juste avec un effet de transparence.

Je sais, je sais, je suis exigeant

[Gilbert Geyer]

Bonjour,

je ne veux pas le fond totalement transparent mais juste avec un effet de transparence. Je sais, je sais, je suis exigeant

... plus t'es exigeant, et plus il faudra du code.

Voir ci-après un code qui resulte de la modification du code trouvé ici : http://nono40.developpez.com/sources/source0028/
que j'ai modifié de façon à :
- créer un Hint rectangulaire,
- récupérer (avec function BmpZoneEcran) le BitMap de la copie d'écran de la zone qui sera occupée par le Hint,
- triturer les composantes R,G,B de ce BitMap de façon à donner un effet de transparence par simple éclaircissement (avec procedure TriturerBmp),
- et à dessiner ce BitMap sur le fond du Canvas du Hint avant d'y dessiner le texte du Hint.

Les principales modifs apportées au code de nono40 pour utiliser BmpZoneEcran et TriturerBmp sont logées dans la Procedure TMonHint.Paint;
Il reste un point à améliorer dans cette procédure c'est de faire coincider exactement le positionnement de la capture d'écran avec la position qui sera occupée par le Hint, à part ceci le reste marche et si l'effet de transparence ne te convient pas il suffit de modifier la procedure TriturerBmp pour l'adapter à tes exigences.

Voiçi le code modifié :

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
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
implementation
 
{$R *.DFM}
 
function  BmpZoneEcran(x,y,w,h : integer) : tBitMap;
var       HandleDCBureau : HDC;
begin     HandleDCBureau:=GetDC(GetDesktopWindow);
          Result:=TBitMap.create;
          try Result.Width  := w;
              Result.Height := h;
              BitBlt( Result.Canvas.Handle,0,0,w,h,
                      HandleDCBureau,x,y,SrcCopy); //recopie l'image de la région d'écran dans Result
          finally
             ReleaseDC(GetDesktopWindow,HandleDCBureau);
          end;
end; //
 
procedure TriturerBmp(var Bmp : TBitMap); // Modifie les composantes R,G,B du Bmp (ici un simple éclaircissement)
const     Delta = 120;
type      PRGBTripleArray = ^TRGBTripleArray;
          TRGBTripleArray = array[0..0] of TRGBTriple;
var       CPC    : PRGBTripleArray;  //Couleur Pixel Courant
          R,G,B  : byte;
          x,y    : integer;
begin     //Force bmp en 24 bits
          Bmp.PixelFormat := pf24bit;
          // Boucle de correction
          for y := 0 to bmp.Height-1 do
          begin CPC := Bmp.ScanLine[y];
                for x := 0 to Bmp.Width-1 do
                begin R:=CPC[x].rgbtRed; G:=CPC[x].rgbtGreen; B:=CPC[x].rgbtBlue;
                      if R+Delta<=255 then inc(R,Delta) else R:=255;
                      if G+Delta<=255 then inc(G,Delta) else G:=255;
                      if B+Delta<=255 then inc(B,Delta) else B:=255;
                      CPC[x].rgbtRed:=R; CPC[x].rgbtGreen:=G; CPC[x].rgbtBlue:=B;
                end;
          end;
end;
 
// Suite = code modifé à partir de http://nono40.developpez.com/sources/source0028/
//         de façon à copier sur le canvas du Hint le bitMap de fond après triturage de ses composantes R,G,B
//
// Pour créer un bulle d'aide personnalisée, il faut créer une
// classe descendante de THintWindow et l'affecter à la variable
// globale HintWindowClass.
Type TMonHint = Class( THintWindow )
       Private
       Protected
         // Variable mise à TRUE à chaque affichage de la bulle
         // pour recréer la région adaptée à la taille du texte
         FCreerRegion  : Boolean;
         // Principalement Paint doit être surchargé pour pouvoir modifier le dessin de la bulle
         Procedure Paint;override;
         // La surcharge de CreateParams permet de modifier les propriété de la
         // fenêtre Windows encapsulée par le THintWindow
         // Ce n'est pas obligatoire, tout dépend du dessin souhaité
         procedure CreateParams(var Params: TCreateParams);Override;
       Public
         // Create est surchargé juste pour initialiser les variables
         constructor Create(AOwner: TComponent); override;
         // ActiveHintData est appelée à chaque nouvel affichage de bulle d'aide.
         // Le fait de la surchargée permet d'être averti d'un nouveau texte
         procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); override;
         // Si la taille par défaut de la bulle doit être modifiée
         // il faut surcharger CalcHintRect. Car cette méthode est appelée avant l'affichage de
         // la bulle pour en déterminer la taille.
         function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
     End;
 
Constructor TMonHint.Create(AOwner: TComponent);
begin       Inherited Create(AOwner);
            // Create n'est surchargé que pour initialiser les variables
            FCreerRegion := False;
end;
 
procedure TMonHint.CreateParams(var Params: TCreateParams);
begin     inherited CreateParams(Params);
          // CreateParams est surcharge pour modifier les paramètre Windows de la bulle.
          // Par défaut le stype est WS_POPUP OR WS_BORDER
          // La fenêtre n'étant pas carrée, il est inutile de dessiner le bord
          Params.Style := WS_POPUP;
end;
 
// Cette méthode est appelée à chaque nouvelle bulle d'aide
// On ne fait que signaler que la région de la fenêtre doit être changée
procedure TMonHint.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer);
begin     Inherited;
          FCreerRegion:=True;
end;
 
// Cette méthode calcule la taille de la bulle en fonction du texte
function TMonHint.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin    // La taille est largeur est limitée à 200 pixels
         // C'est plus joli pour les textes longs
         MaxWidth:=200;
         // La valeur par défaut est mofiée afin de d'avoir la place de dessiner
         // les contours
         Result:=Inherited CalcHintRect(MaxWidth,AHint,AData);
         //Inc(Result.Right ,10);
         //Inc(Result.Bottom,30);
         //Inc(Result.Bottom,10);
end;
 
// Paint est la méthode de dessin de la bulle
Procedure TMonHint.Paint;
var Rect : TRect;
    Rgn1 : HRgn;
    Rgn2 : HRgn;
    BmpFond : TBitMap; //<- BitMap du Fond d'écran sous le Hint
    p1,p2   : TPoint;
begin
  // ClientRect à été déterminé par la méthode CalcHintRect.
  // On se sert alors de la zone Client pour calculer la région
  Rect := ClientRect;
  // FCreerRegion est mis à true à chaque apparition de la bulle d'aide.
  // Donc s'il est à True il faut recalculer la région de la fenêtre en
  // fonction du nouveau texte
  If FCreerRegion Then
  Begin
    // Récup du BmpFond par copie d'écran :
    p1.x:=Rect.Left; p1.y:=Rect.Top; p2.x:=Rect.Right; p2.y:=Rect.Bottom;
    p1:=ClientToScreen(p1); p2:=ClientToScreen(p2);
    BmpFond:=BmpZoneEcran(p1.x, p1.y+15, p2.x-p1.x, p2.y-p1.y);
    // LES TOIS LIGNES PRECEDENTES SONT A AMELIORER POUR AJUSTER CORRECTEMENT LA COPIE D'ECRAN
    // EN FONCTION DE LA POSITION DU HINT
    TriturerBmp(BmpFond);
 
    // Création d'une région rectangulaire
    //Rgn2 :=CreateRectRgn(Rect.Left,Rect.Top+20,Rect.Right,Rect.Bottom);
    Rgn2 :=CreateRectRgn(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
    // La forme de la bulle ( région ) est appliqué afin que la fenêtre Windows
    // en prenne la forme.
    SetWindowRgn(Handle,Rgn2,True );
    // Ceci n'est effectué qu'une fois pour chaque appartion de la bulle
    // Car la fenêtre Windows conserve sa région jusqu'a la destruction
    // ou l'association d'une autre région
    FCreerRegion:=False;
  End;
 
  // Pour effectuer le dession lui-même, on récupère la région de base
  // Rgn1 est créé avec une région "bidon" car il faut seulement qu'elle existe
  // avant l'appel de GetWindowRgn
  rgn1:=CreateRectRgn(0,0,10,10);
  GetWindowRgn(Handle,rgn1);
 
  // Dessin du BmpFond sur le canvas du Hint :
  Canvas.Brush.Bitmap:=BmpFond;
  Canvas.FillRect(Rect);
 
  // Dessiner le texte au centre de la bulle
  InflateRect(Rect,-2,-2);
  Canvas.Brush.Style:=bsClear;
  Canvas.Font.Style:=[fsBold];
  DrawText(Canvas.Handle, PChar(Caption), -1, Rect , DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
  Canvas.Font.Style:=[];
 
  // FrameRgn() est une fonction qui dessine un contour autour de la région
  // même si celle-ci est d'une forme complexe.
  Canvas.Brush.Color:=clGreen;
  FrameRgn(Canvas.Handle,rgn1,Canvas.Brush.Handle,1,1);
  DeleteObject(rgn1);
End;
 
procedure TForm1.FormCreate(Sender: TObject);
begin     bouton1.hint:= 'Tagada trucMuche'+#13#10
                         +'suite du texte'; // ici Texte sur deux lignes
            bouton1.ShowHint:=True;
end;
 
Initialization
          // Il faut bien sur définir la nouvelle bulle d'aide comme étant
          // classe utilisée par défaut :
          HintWindowClass:=TMonHint;
          Application.HintHidePause := 10000;
end.

Pour tester ce code il suffit d'une Form comportant un Bouton1 sous lequel on place un TImage chargé avec un BitMap simulant un fond multicolore dans la zone d'apparition du Hint associé à ce bouton et de faire glisser le curseur-souris par-dessus le bouton. (selon que l'on glisse du haut vers le bas , etc, à l'approche du bouton il n'y a pas toujours concidence : ce point est à améliorer, j'ai baggaré sans y arriver)

A+

[dragonno]

La couleur de transparence (pour un composant qui possède la transparence) peut se choisir par un code à l'execution ?
Si c'est oui on peut peut-etre prendre une couleur qui fasse demie-transparence ?
Je dis n'importe quoi^^

[dragonno]

Alors pas moyen d'avoir la transparence sur un Tpanel ?
ça m'interesse aussi

[Bruno13]

Salut Gilbert,

J'avais abandonné tout espoir car je n'avais rien trouvé sur la transparence pour un TPanel.

Dès que j'ai un peu de temps cette semaine, je teste ton source sur mon appli et je te dis ce que cela a donné.

Mille merci pour ta contribution et ton aide,

Amicalement,
Bruno

[Sh0ck]

De même, ça m'intéresse aussi, j'ai d'ailleurs posté un topic pour demander ceci, j'espère que ta réponse sera positive Bruno13, ça m'aiderait pas mal =)

[Gilbert Geyer]

Bonjour,

J'ai été privé des services de ma Freebox du lundi 19 jusqu'à ce matin où tout est rentré dans l'ordre ... Mais ceci m'a laissé du loisir pour fignoler le code ci-après qui crée un Hint semi-transparent et complété par une ombre style XP si XP est détecté sinon on se passe de l'ombre.
Le degré de transparence est réglable car une transparence trop nette risquerait d'altérer la lisibilité du Hint dans le cas d'un fond d'écran bariolé.
Donc faudra, lors de la conception, ajuster la valeur du paramètre Delta de la procedure EclaircirBmp(var Bmp : TBitMap; Delta : byte); en fonction de l'arrière-plan. (si Delta=0 alors transparence à 100% ... et si Delta = 255 alors fond blanc opaque)
Dans l'unité ci-jointe j'ai fixé Delta à 160 ce qui fait qu'une photo d'une fleur de couleurs du style "clair-obscur" apparaît au travers du Hint comme la même mais de couleurs pastel-claires ce qui donne une lisibilité convenable du texte du Hint.

Voiçi le code de l'unité

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
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
unit uHintSemiTransparent;
 
//******************************************************************************
// Pour créer des Hint rectangulaires personnalisés avec un fond semi-transparent
//             et avec ombre style Windows XP si XP est détecté.
//
// - Le degré de transparence peut être réglé en modifiant la valeur du paramètre
//   Delta lors de l'appel de la procédure EclaircirBmp. Attention une transparence
//   trop nette peut altérer la lisibilité du texte du Hint.
// - La police de caractères et ses attributs peuvent être modifiés dans le Constructor TMonHint.Create
// - La couleur du contour du Hint et l'épaisseur de ses bords peuvent être modifiées
//   dans la procedure TMonHint.Paint
//******************************************************************************
 
interface
 
uses
  Windows, Classes, SysUtils, Graphics, Controls;
 
function  BmpZoneEcran(xe,ye,w,h : integer) : tBitMap;   // Copie zone d'écran
//        (utilisé pour copier la zone-écran sous-jacente du Hint)
 
procedure EclaircirBmp(var Bmp : TBitMap; Delta : byte); // Augmente de Delta les composantes R,G,B du Bmp
//        (utilisé pour créer l'effet de semi-transparence à partir de la copie d'écran)
 
 
// SUITE = code modifé à partir de http://nono40.developpez.com/sources/source0028/
//         de façon à créer le Hint rectangulaire avec fond semi-transparent
//
// Pour créer une bulle d'aide personnalisée, il faut créer une classe descendante
// de THintWindow et l'affecter à la variable globale HintWindowClass.
Type TMonHint = Class( THintWindow )
       Private
         BmpFond : TBitMap; //<- BitMap du Fond d'écran sous le Hint
       Protected
         FCreerRegion  : Boolean;  //<- Variable mise à TRUE à chaque affichage de la bulle
                                   // pour recréer la région adaptée à la taille du texte
         Procedure Paint;override; //<- Paint doit être surchargée de manière à personnaliser le dessin de la bulle
 
         procedure CreateParams(var Params: TCreateParams);override;
         //<- La surcharge de CreateParams permet de modifier les propriété de la
         // fenêtre Windows encapsulée par le THintWindow.
         // Ce n'est pas obligatoire, tout dépend du dessin souhaité.
       Public
 
         constructor Create(AOwner: TComponent);override;
         //<- Create est surchargé juste pour initialiser des variables
 
         function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
         //<- Si la taille par défaut de la bulle doit être modifiée
         // il faut surcharger CalcHintRect, car cette méthode est appelée avant l'affichage de
         // la bulle pour en déterminer la taille.
 
         procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); override;
         //<- ActiveHintData est appelée à chaque nouvel affichage de bulle d'aide.
         // Le fait de la surcharger permet d'être averti d'un nouveau texte
 
         destructor Destroy; override;
     End;
 
implementation
 
function  BmpZoneEcran(xe,ye,w,h : integer) : tBitMap; // Copie zone d'écran
//        xe,ye = coordonnées-écran de l'angle sup gauche
//        w,h   = width, height
var       HandleDCBureau : HDC;
begin     HandleDCBureau:=GetDC(GetDesktopWindow);
          Result:=TBitMap.create;
          try Result.Width  := w;
              Result.Height := h;
              BitBlt( Result.Canvas.Handle,0,0,w,h,
                      HandleDCBureau,xe,ye,SrcCopy);
          finally
             ReleaseDC(GetDesktopWindow,HandleDCBureau);
          end;
end;
 
procedure EclaircirBmp(var Bmp : TBitMap; Delta : byte); // Augmente de Delta les composantes R,G,B du Bmp
//        si Delta = 0 alors transparence à 100%
//        si Delta = 255 alors fond blanc opaque
type      PRGBTripleArray = ^TRGBTripleArray;
          TRGBTripleArray = array[0..0] of TRGBTriple;
var       CPC    : PRGBTripleArray;  //Couleur Pixel Courant
          R,G,B  : byte;             //Composantes R,G,B
          x,y    : integer;
begin     //Force Bmp en 24 bits
          Bmp.PixelFormat := pf24bit;
          // Boucles d''éclaircissement :
          for y := 0 to bmp.Height-1 do
          begin CPC := Bmp.ScanLine[y];
                for x := 0 to Bmp.Width-1 do
                begin R:=CPC[x].rgbtRed; G:=CPC[x].rgbtGreen; B:=CPC[x].rgbtBlue;
                      if R+Delta<=255 then inc(R,Delta) else R:=255;
                      if G+Delta<=255 then inc(G,Delta) else G:=255;
                      if B+Delta<=255 then inc(B,Delta) else B:=255;
                      CPC[x].rgbtRed:=R; CPC[x].rgbtGreen:=G; CPC[x].rgbtBlue:=B;
                end;
          end;
end;
 
function IsWinXP: Boolean; // si true alors il s'agit de Windows XP
begin    Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
         (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
end;
 
Constructor TMonHint.Create(AOwner: TComponent);
begin       Inherited Create(AOwner);
            // Create n'est surchargé que pour initialiser des variables
            FCreerRegion := False;
            with Canvas.Font do
            begin Name := 'Arial';
                  Style := [fsBold];
                  Color := clBlack;
            end;
end;
 
procedure TMonHint.CreateParams(var Params: TCreateParams);
const     CS_DROPSHADOW = $00020000; //<- ajout ombre style Windows XP si XP est détecté.
begin     inherited CreateParams(Params);
          // CreateParams est surchargée pour modifier les paramètres Windows de la bulle.
          // Par défaut le stype est WS_POPUP OR WS_BORDER
          if IsWinXP
          then Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW
          else Params.Style := WS_POPUP;
end;
 
// Cette méthode calcule la taille de la bulle en fonction du texte
function TMonHint.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin    // Limitation à 200 pixels de la taille en largeur, c'est plus joli
         // pour les textes longs :
         MaxWidth:=200;
         Result:=Inherited CalcHintRect(MaxWidth,AHint,AData);
end;
 
// Cette méthode est appelée à chaque nouvelle bulle d'aide
procedure TMonHint.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer);
//        Affiche le Hint aux coordonnées spécifiées par le paramètre Rect.
begin     // Elargissement de Rect pour créer des marges gauche-droite :
          with Rect do Right := Right + Canvas.TextWidth('oo');
 
          if Assigned(BmpFond) then BmpFond.Free;
          // Récup du BmpFond par copie d'écran :
          BmpFond:=BmpZoneEcran(Rect.Left,Rect.Top,Rect.Right-Rect.Left,Rect.Bottom-Rect.Top+5);
          EclaircirBmp(BmpFond, 160); //<- ici éclaircissement de 160 sur 255
          Inherited;
          FCreerRegion:=True;
end;
 
// Dessin de la bulle d''aide :
Procedure TMonHint.Paint;
const     epBordVertical = 1; epBordHorizontal =1; //<Epaisseurs bords du contour
var       Rect : TRect; Rgn1,Rgn2 : HRgn;  DC : HDC;
begin     // ClientRect à été déterminé par la méthode CalcHintRect.
          // On se sert alors de la zone Client pour calculer la région
          Rect := ClientRect;
          // FCreerRegion est mis à true à chaque apparition de la bulle d'aide.
          // Donc s'il est à True il faut recalculer la région de la fenêtre en
          // fonction du nouveau texte.
          if FCreerRegion then
          begin // Création d'une région rectangulaire
                Rgn2 :=CreateRectRgn(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
                // La forme de la bulle ( région ) est appliquée afin que la fenêtre Windows
                // en prenne la forme.
                SetWindowRgn(Handle,Rgn2,True );
                // Ceci n'est effectué qu'une fois pour chaque appartion de la bulle
                // Car la fenêtre Windows conserve sa région jusqu'a la destruction
                // ou l'association d'une autre région
                FCreerRegion:=False;
                DeleteObject(rgn2);
          end;
          // Pour effectuer le dession lui-même, on récupère la région de base
          // Rgn1 est créé avec une région "bidon" car il faut seulement qu'elle existe
          // avant l'appel de GetWindowRgn
          rgn1:=CreateRectRgn(0,0,10,10);
          GetWindowRgn(Handle,rgn1);
 
          // Dessin du BmpFond semi-transparent sur le canvas du Hint :
          Canvas.Brush.Bitmap:=BmpFond;
          Canvas.FillRect(Rect);
 
          // Dessin du contour autour du Hint :
          DC := GetWindowDC(Handle);
          // A) Soit avec FrameRgn utilisable même si la région est de forme complexe :
               Canvas.Brush.Color:=clRed; //<- couleur rouge
               FrameRgn(DC, rgn1, Canvas.Brush.Handle, epBordVertical, epBordHorizontal);
               DeleteObject(rgn1);
 
          // B) Soit avec DrawEdge si le Hint est rectangulaire (contour noir) :
          //DrawEdge(DC, Rect, EDGE_ETCHED, BF_RECT or BF_MONO); //<- OK marche aussi
          ReleaseDC(Handle, DC);
 
          //Accentuation coin supérieur gauche du Hint :
          with canvas do
          begin pen.color:=clRed; pen.width:=4;
                MoveTo(-2,3); LineTo(3,-2);
          end;
 
          // Dessin du texte au centre de la bulle :
          InflateRect(Rect,-2,-2);
          Canvas.Brush.Style:=bsClear;
          DrawText(Canvas.Handle, PChar(Caption), -1, Rect , DT_CENTER or DT_NOPREFIX or DT_WORDBREAK);
End;
 
destructor TMonHint.Destroy;
begin      if Assigned(BmpFond) then BmpFond.Free;
           inherited;
end;
 
// La ligne suivante, au moins, doit être placée soit dans la procedure
// TForm1.FormCreate(Sender: TObject) de l'unité principale de l'application,
// soit dans sa partie Initialization :
 
//           HintWindowClass:=TMonHint; //<- Pour déclarer la nouvelle bulle d'aide comme étant la classe utilisée par défaut
//           Application.HintHidePause := 10000; //<- 10 secondes = Durée d'affichage du Hint, sinon valeur par défaut = 2 secondes 1/2
 
end.

... et voiçi le code de l'unité qui utilise la précédente :

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
unit uUtiliseHintSemiTranspa;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls,
  uHintSemiTransparent, jpeg;
 
type
  TForm1 = class(TForm)
    bouton1: TSpeedButton; //<- Bouton avec Hint + ShowHint:=true
    Image1: TImage;        //<- Image avec photo ou dessin polychrome situé sous bouton1
    RichEdit1: TRichEdit;  //<- RichEdit avec du texte situé sous bouton1
                           //   (soit deux façons pour régler le degré de transparence
                           //    du Hint de sorte que sa lisibilté ne soit pas
                           //    altérée par l'arrière-plan
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin     bouton1.hint:= 'Tagada trucMuche'+#13#10
                         +'suite 1 du texte'+#13#10
                         +'suite 2 du texte'+#13#10
                         +'suite 3 du texte';  //<- ex : texte du hint sur 4 lignes
          bouton1.ShowHint:=True;
end;
 
initialization
 
          HintWindowClass:=TMonHint; //<- Déclaration de la nouvelle bulle d''aide en tant que classe utilisée par défaut
          Application.HintHidePause := 10000; //<- ici 10 secondes de durée d'affichage du hint 
 
END.

A+