unit ProgramHint;
interface
uses
Vcl.Controls,
System.Classes,
Winapi.Windows;
type
TProgramHint = class(THintWindow)
private
procedure AppHint(var HintStr: string; var CanShow:
Boolean; var HintInfo: Vcl.Controls.THintInfo);
protected
procedure Paint(); override;
public
function ShouldHideHint(): Boolean; override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
public
constructor Create(AOwner: TComponent); override;
end;
implementation
uses
Vcl.Forms,
System.Types;
constructor TProgramHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Canvas.Font.Size := 9;
Canvas.Font.Name := 'Tahoma';
Application.OnShowHint := Self.AppHint;
end;
procedure TProgramHint.Paint();
var
R: TRect;
begin
R := Rect(10, 10, ClientRect.Right, ClientRect.Bottom);
DrawText(Canvas.handle, Caption, Length(Caption), R, DT_WORDBREAK);
end;
function TProgramHint.ShouldHideHint(): Boolean;
begin
Result := True;
end;
procedure TProgramHint.AppHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: Vcl.Controls.THintInfo);
begin
HintInfo.HintMaxWidth := 300;
HintInfo.HideTimeout := 20 * 1000; end;
procedure TProgramHint.ActivateHint(Rect: TRect; const AHint: string);
begin
if ProgramConfig.GUI.ShowHints then
begin
Inc(Rect.Bottom, 20);
Inc(Rect.Right, 20);
UpdateBoundsRect(Rect);
inherited;
end;
end;
initialization
Application.ShowHint := False;
HintWindowClass := TProgramHint;
Application.ShowHint := True;
end.