Mega Code Archive
Changing the look of the HintWindowClass
<![CDATA[
Title: Changing the look of the HintWindowClass
Question: How can I have a different look for my hint !!!
Answer:
****************************************************************************
In Project/View source, before you call the RUN routine, just add the following line:
****************************************************************************
HintWindowClass := TMyHint; //Name of the class defined by the user
****************************************************************************
There is the unit
****************************************************************************
unit AGHint;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms;
type
//Position of main application logo in hint display area
TAGLogoPosition = (aglpLeft, aglpTop, aglpRight, aglpBottom);
//To determine if the application logo should be displayed or not
TAGApplicationLogo = class(TPersistent)
private
FVisible: Boolean;
FPosition: TAGLogoPosition;
published
property Visible: Boolean read FVisible write FVisible;
property Position: TAGLogoPosition read FPosition write FPosition;
end;
//Main class redefinition (some ajustements)
TAGSubHint = class(THintWindow)
protected
procedure Paint; override;
public
procedure ActivateHint(ARect: TRect; const AHint: string); override;
end;
//New main class definition
TAGHint = class(TComponent)
private
FIconH: Integer;
FIconW: Integer;
FOffset: Integer;
FColor: TColor;
FTmpColor: TColor;
FFont: TFont;
FApplicationLogo: TAGApplicationLogo;
FEnabled: Boolean;
procedure SetEnabled(const Value: Boolean);
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ApplicationLogo: TAGApplicationLogo read FApplicationLogo write FApplicationLogo;
property Color: TColor read FColor write FColor;
property Enabled: Boolean read FEnabled write SetEnabled;
property Font: TFont read FFont write FFont;
end;
procedure Register;
implementation
var
xAGHint: TAGHint;
procedure Register;
begin
RegisterComponents('MyPalette', [TAGHint]);
end;
{ TAGHint }
constructor TAGHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FApplicationLogo := TAGApplicationLogo.Create;
FApplicationLogo.Visible := True;
FApplicationLogo.Position := aglpLeft;
FIconH := Application.Icon.Height;
FIconW := Application.Icon.Width;
FColor := clInfoBk;
FEnabled := True;
FOffset := 5;
FFont := TFont.Create;
FFont.Name := 'Arial';
FFont.Size := 12;
end;
destructor TAGHint.Destroy;
begin
FFont.Free;
FApplicationLogo.Free;
inherited Destroy;
end;
procedure TAGHint.SetEnabled(const Value: Boolean);
begin
if FEnabled Value then
FEnabled := Value;
if FEnabled then
begin
if not (csDesigning in ComponentState) then
begin
if FEnabled then
begin
FIconH := Application.Icon.Height;
FIconW := Application.Icon.Width;
xAGHint := Self;
xAGHint.FTmpColor := Application.HintColor;
Application.HintColor := FColor;
HintWindowClass := TAGSubHint;
end
else
begin
FIconH := 0;
FIconW := 0;
Application.HintColor := FTmpColor;
xAGHint := nil;
if HintWindowClass = TAGSubHint then
HintWindowClass := THintWindow;
end;
end;
end;
end;
{ TAGSubHint }
procedure TAGSubHint.ActivateHint(ARect: TRect; const AHint: string);
var
H: Integer;
W: Integer;
begin
Canvas.Font.Assign(xAGHint.Font);
if xAGHint.ApplicationLogo.Visible then
begin
xAGHint.FIconH := Application.Icon.Height;
xAGHint.FIconW := Application.Icon.Width;
if (xAGHint.ApplicationLogo.Position = aglpLeft) or (xAGHint.ApplicationLogo.Position = aglpRight) then
begin
W := Canvas.TextWidth(AHint) + (xAGHint.FOffset * 2);
if xAGHint.FIconW 0 then
W := W + xAGHint.FIconW + xAGHint.FOffset;
H := Canvas.TextHeight(AHint) + (xAGHint.FOffset * 2);
if (xAGHint.FIconH 0) and (xAGHint.FIconH H) then
H := xAGHint.FIconH + (xAGHint.FOffset * 2);
end
else
if (xAGHint.ApplicationLogo.Position = aglpTop) or (xAGHint.ApplicationLogo.Position = aglpBottom) then
begin
H := Canvas.TextHeight(AHint) + (xAGHint.FOffset * 2);
if xAGHint.FIconH 0 then
H := H + xAGHint.FIconH + xAGHint.FOffset;
W := Canvas.TextWidth(AHint) + (xAGHint.FOffset * 2);
if (xAGHint.FIconW 0) and (xAGHint.FIconW W) then
W := xAGHint.FIconW + (xAGHint.FOffset * 2);
end;
end
else
begin
xAGHint.FIconH := 0;
xAGHint.FIconW := 0;
H := Canvas.TextHeight(AHint) + (xAGHint.FOffset * 2);
W := Canvas.TextWidth(AHint) + (xAGHint.FOffset * 2);
end;
ARect := Rect(ARect.Left,ARect.Top,ARect.Left + W + 3,ARect.Top + H);
BoundsRect := ARect;
inherited ActivateHint(ARect, AHint);
end;
procedure TAGSubHint.Paint;
var
H : Integer;
W : Integer;
Rct: TRect;
begin
Canvas.Font.Assign(xAGHint.Font);
Rct := ClientRect;
H := Rct.Bottom - Rct.Top;
W := Rct.Right - Rct.Left;
if xAGHint.ApplicationLogo.Visible then
begin
xAGHint.FIconH := Application.Icon.Height;
xAGHint.FIconW := Application.Icon.Width;
if xAGHint.ApplicationLogo.Position = aglpLeft then
begin
Canvas.Draw(Rct.Left + xAGHint.FOffset, Rct.Top + ((H - xAGHint.FIconH) div 2), Application.Icon);
Rct.Left := Rct.Left + xAGHint.FIconW + (xAGHint.FOffset * 2);
Rct.Top := Rct.Top + ((H - Canvas.TextHeight(PChar(Caption))) div 2);
end
else
if xAGHint.ApplicationLogo.Position = aglpRight then
begin
Canvas.Draw(Rct.Right - xAGHint.FIconW - xAGHint.FOffset, Rct.Top + ((H - xAGHint.FIconH) div 2), Application.Icon);
Rct.Left := Rct.Left + xAGHint.FOffset;
Rct.Top := Rct.Top + ((H - Canvas.TextHeight(PChar(Caption))) div 2);
end
else
if xAGHint.ApplicationLogo.Position = aglpTop then
begin
Canvas.Draw(Rct.Left + ((W - xAGHint.FIconW) div 2), Rct.Top + xAGHint.FOffset, Application.Icon);
Rct.Top := Rct.Top + xAGHint.FIconH + (xAGHint.FOffset * 2);
Rct.Left := Rct.Left + xAGHint.FOffset;
end
else
if xAGHint.ApplicationLogo.Position = aglpBottom then
begin
Canvas.Draw(Rct.Left + ((W - xAGHint.FIconW) div 2), Rct.Bottom - xAGHint.FIconH - xAGHint.FOffset, Application.Icon);
Rct.Top := Rct.Top + xAGHint.FOffset;
Rct.Left := Rct.Left + xAGHint.FOffset;
end;
DrawText(Canvas.Handle, PChar(Caption), -1, Rct, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK)
end
else
begin
xAGHint.FIconH := 0;
xAGHint.FIconW := 0;
Canvas.TextRect(Rct, xAGHint.FOffset, xAGHint.FOffset, Caption);
end;
end;
end.
]]>