D5DG例子,只要uses下面的Unit,就一个与众不同的tip出现。
{
Copyright ?1998 by Delphi 4 Developer's Guide - Xavier Pacheco and Steve Teixeira
}unit CoolHint;interfaceuses Windows, Classes, Controls, Forms, Messages, Graphics;type TddgHintWindow = class(THintWindow)
private
FRegion: THandle;
procedure FreeCurrentRegion;
public
destructor Destroy; override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
end;implementationdestructor TddgHintWindow.Destroy;
begin
FreeCurrentRegion;
inherited Destroy;
end;procedure TddgHintWindow.CreateParams(var Params: TCreateParams);
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not ws_Border; // remove border
end;procedure TddgHintWindow.FreeCurrentRegion;
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
if FRegion <> 0 then begin // if Region is alive...
SetWindowRgn(Handle, 0, True); // set win region to 0
DeleteObject(FRegion); // kill the region
FRegion := 0; // zero out field
end;
end;procedure TddgHintWindow.ActivateHint(Rect: TRect; const AHint: string);
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
with Rect do
Right := Right + Canvas.TextWidth('WWWW'); // add some slop
BoundsRect := Rect;
FreeCurrentRegion;
with BoundsRect do
{ Create a round rectangular region to display the hint window }
FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height);
if FRegion <> 0 then
SetWindowRgn(Handle, FRegion, True); // set win region
inherited ActivateHint(Rect, AHint); // call inherited
end;procedure TddgHintWindow.Paint;
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
R: TRect;
begin
R := ClientRect; // get bounding rectangle
Inc(R.Left, 1); // move left side slightly
Canvas.Font.Color := clInfoText; // set to proper color
{ paint string in the center of the round rect }
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;var
OldHintClass: THintWindowClass;function SetNewHintClass(AClass: THintWindowClass): THintWindowClass;
var
DoShowHint: Boolean;
begin
Result := HintWindowClass; // return value is old hint window
DoShowHint := Application.ShowHint;
if DoShowHint then
Application.ShowHint := False; // destroy old hint window
HintWindowClass := AClass; // assign new hint window
if DoShowHint then
Application.ShowHint := True; // create new hint window
end;initialization
OldHintClass := SetNewHintClass(TddgHintWindow);finalization
SetNewHintClass(OldHintClass);end.
{
Copyright ?1998 by Delphi 4 Developer's Guide - Xavier Pacheco and Steve Teixeira
}unit CoolHint;interfaceuses Windows, Classes, Controls, Forms, Messages, Graphics;type TddgHintWindow = class(THintWindow)
private
FRegion: THandle;
procedure FreeCurrentRegion;
public
destructor Destroy; override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
end;implementationdestructor TddgHintWindow.Destroy;
begin
FreeCurrentRegion;
inherited Destroy;
end;procedure TddgHintWindow.CreateParams(var Params: TCreateParams);
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not ws_Border; // remove border
end;procedure TddgHintWindow.FreeCurrentRegion;
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
if FRegion <> 0 then begin // if Region is alive...
SetWindowRgn(Handle, 0, True); // set win region to 0
DeleteObject(FRegion); // kill the region
FRegion := 0; // zero out field
end;
end;procedure TddgHintWindow.ActivateHint(Rect: TRect; const AHint: string);
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
with Rect do
Right := Right + Canvas.TextWidth('WWWW'); // add some slop
BoundsRect := Rect;
FreeCurrentRegion;
with BoundsRect do
{ Create a round rectangular region to display the hint window }
FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height);
if FRegion <> 0 then
SetWindowRgn(Handle, FRegion, True); // set win region
inherited ActivateHint(Rect, AHint); // call inherited
end;procedure TddgHintWindow.Paint;
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
R: TRect;
begin
R := ClientRect; // get bounding rectangle
Inc(R.Left, 1); // move left side slightly
Canvas.Font.Color := clInfoText; // set to proper color
{ paint string in the center of the round rect }
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;var
OldHintClass: THintWindowClass;function SetNewHintClass(AClass: THintWindowClass): THintWindowClass;
var
DoShowHint: Boolean;
begin
Result := HintWindowClass; // return value is old hint window
DoShowHint := Application.ShowHint;
if DoShowHint then
Application.ShowHint := False; // destroy old hint window
HintWindowClass := AClass; // assign new hint window
if DoShowHint then
Application.ShowHint := True; // create new hint window
end;initialization
OldHintClass := SetNewHintClass(TddgHintWindow);finalization
SetNewHintClass(OldHintClass);end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货