Afficher un Bitmap de fond dans les Hint

//enregistrer un fichier bmp sous 'D:hint.bmp'

type
TGraphicHintWindow = class(THintWindow)
const ructor Create(AOwner: TComponent); override;
private
FActivating: Boolean;
public
procedure ActivateHint(Rect: TRect; const AHint: string); override;
protected
procedure Paint; override;
published
property Caption;
end;

{...}

const ructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

{
Here you can set custom Font Properties:
}

with Canvas.Font do
begin
Name := 'Arial';
Style := Style + [fsBold];
Color := clBlack;
end;
end;

procedure TGraphicHintWindow.Paint;
var
R: TRect;
bmp: TBitmap;
begin
R := ClientRect;
Inc(R.Left, 2);
Inc(R.Top, 2);

{*******************************************************
The folowing Code ist an example how to create a custom
Hint Object. :
}

bmp := TBitmap.Create;
bmp.LoadfromFile('D:hint.bmp');

with Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clsilver;
Pen.Color := clgray;
Rectangle(0, 0, 18, R.Bottom + 1);
Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
end;

bmp.Free;
//custom Hint Color
Color := clWhite;

Canvas.Brush.Style := bsClear;
Canvas.TextOut(20, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption);
{********************************************************}
end;

procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
FActivating := True;
try
Caption := AHint;
//Höhe des Hints setzen setzen
//Set the "Height" Property of the Hint
Inc(Rect.Bottom, 14);
//Breite des Hints setzen
//Set the "Width" Property of the Hint
Rect.Right := Rect.Right + 20;
UpdateBoundsRect(Rect);
if Rect.Top + Height > Screen.DesktopHeight then
Rect.Top := Screen.DesktopHeight - Height;
if Rect.Left + Width > Screen.DesktopWidth then
Rect.Left := Screen.DesktopWidth - Width;
if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
SWP_SHOWWINDOW or SWP_NOACTIVATE);
Invalidate;
finally
FActivating := False;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
HintWindowClass := TGraphicHintWindow;
Application.ShowHint := False;
Application.ShowHint := True;
end;
Ajouter un commentaire
Pseudo
Adresse email
Site internet (optionnel)
Votre commentaire
Fiche de l'article
Mise a jour12/09/2004
VisualisationVu 1830 fois
PublicInternaute zz
CategorieDelphi - Trucs et astuces - Surface
Auteur de l'article
Communauté Delphi Communauté Delphi
connecté le 02/11/2011
0 articles dans la section
Contacter l'auteur