Mega Code Archive
How to Create a graphical hint
<![CDATA[
Title: How to Create a graphical hint
type
TGraphicHintWindow = class(THintWindow)
constructor Create(AOwner: TComponent); override;
private
FActivating: Boolean;
public
procedure ActivateHint(Rect: TRect; const AHint: string); override;
protected
procedure Paint; override;
published
property Caption;
end;
{...}
constructor 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;
//Set the "Height" Property of the Hint
Inc(Rect.Bottom, 14);
//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 .DesktopLeft then Rect.Left := Screen.DesktopLeft;
if Rect.Bottom .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;
]]>