unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMyHintWindowClass = class(THintWindow)
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
function CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
HintWindowClass := TMyHintWindowClass;
end;
{ TMyHintWindowClass }
procedure TMyHintWindowClass.ActivateHint(Rect: TRect;
const AHint: string);
const
shadow_size = 4;
var
r1,r2: HRGN;
i,j: integer;
begin
inherited ActivateHint(Rect,AHint);
r1 := CreateRectRgn(0,0,width-1,height-1);
r2 := CreateRectRgn(width-shadow_size-1,0,width-1,shadow_size);
CombineRgn(r1,r1,r2,RGN_XOR);
DeleteObject(r2);
r2 := CreateRectRgn(0,height-shadow_size-1,shadow_size,height-1);
CombineRgn(r1,r1,r2,RGN_XOR);
DeleteObject(r2);
for i := width-shadow_size-1 to width-2 do
for j := shadow_size to height-2 do
if (i+j) and 1 = 0 then begin
r2 := CreateRectRgn(i,j,i+1,j+1);
CombineRgn(r1,r1,r2,RGN_XOR);
DeleteObject(r2);
end;
for i := shadow_size to width-shadow_size-2 do
for j := height-shadow_size-1 to height-2 do
if (i+j) and 1 = 0 then begin
r2 := CreateRectRgn(i,j,i+1,j+1);
CombineRgn(r1,r1,r2,RGN_XOR);
DeleteObject(r2);
end;
SetWindowRgn(Handle,r1,true);
DeleteObject(r1);
end;
function TMyHintWindowClass.CalcHintRect(MaxWidth: Integer;
const AHint: string; AData: Pointer): TRect;
begin
Result := Rect(0,0,Canvas.TextWidth(AHint)+10*2,Canvas.TextHeight(AHint)+8*2);
end;
constructor TMyHintWindowClass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
procedure TMyHintWindowClass.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := WS_POPUP;
end;
procedure TMyHintWindowClass.Paint;
const
shadow_size = 4;
var
i,j: integer;
rc: TRect;
begin
with Canvas do begin
Brush.Color := clInfoText;
FillRect(ClientRect);
Brush.Color := clInfoBk;
Pen.Color := clInfoText;
Rectangle(0,0,width-shadow_size-1,height-shadow_size-1);
rc := ClientRect;
dec(rc.Right,shadow_size+1);
dec(rc.Bottom,shadow_size+1);
Windows.DrawText(Handle,pChar(Caption),Length(Caption),rc,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;
end.