一个小控件 (2001年3月1日).txt

自己对DELPHI学习的一点体会

一个小控件 (2001年3月1日) 

网友更新  分类:数据库   作者:George  推荐:GeorgeAPI   阅读次数:353  
(http://www.codesky.net)  

--------------------------------------------------------------------------------
unit georgeHintWindow;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TgeorgeHintWindow = class(THintWindow)
private
{ Private declarations }
FRegion:THandle;
procedure FreeCurrentRegion;
protected
{ Protected declarations }
public
{ Public declarations }
destructor Destroy;override;
procedure ActivateHint(Rect:TRect;const AHint:string);override;
procedure Paint;override;
procedure CreateParams(var Params:TCreateParams);override;
published
{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('DDG', [TgeorgeHintWindow]);
end;

{ TgeorgeHintWindow }

procedure TgeorgeHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
with Rect do
Right:=Right+Canvas.TextWidth('WWWW');
BoundsRect:=Rect;
FreeCurrentRegion;
with BoundsRect do
FRegion:=CreateRoundRectRgn(0,0,Width,Height,Width,Height);
if FRegion<>0 then
SetWindowRgn(Handle,FRegion,True);
inherited ActivATeHint(Rect,AHint);
end;

procedure TgeorgeHintWindow.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style and not ws_Border;
end;

destructor TgeorgeHintWindow.Destroy;
begin
FreeCurrentRegion;
Inherited Destroy;
end;

procedure TgeorgeHintWindow.FreeCurrentRegion;
begin
if FRegion<>0 then begin
SetWindowRgn(Handle,0,True);
DeleteObject(FRegion);
FRegion:=0;
end;
end;

procedure TgeorgeHintWindow.Paint;
var
R:TRect;
begin
R:=ClientRect;
Inc(R.Left,1);
Canvas.Font.Color:=clInfoText;
DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
//inherited;

end;
initialization
application.ShowHint:=false;
HintWindowClass:=tgeorgeHintWindow;
application.ShowHint:=true;
end.
应用:
请不安装,直接在应用程序use他,ＯＫ!