Mega Code Archive
Create a graphical hint
<![CDATA[
{*********************************************************
Mit Hilfe des folgendes Codes lassen sich leicht beliebige
Hints erstellen. Dazu muss nur dir Prozedur "Paint" den
Wünschen entsprechend angepasst werden.
With the following Code you can simply create custom hints.
You just have to change the procedur "Paint".
*********************************************************}
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);
{
Hier können beliebige Schrift Eigenschaften gesetzt
werden.
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);
{*******************************************************
Der folgende Code ist ein Beispiel wie man die Paint
Prozedur nutzen kann um einen benutzerdefinierten Hint
zu erzeugen.
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;
//Beliebige HintFarbe
//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;
]]>