如何做自定义形状的Hint,如椭圆，气泡形，字体大小可变等？

Question

这里是一个完整的组件代码，你可以看看
unit Danhint;interfaceuses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;type
  THintDirection=(hdUpRight,hdUpLeft,hdDownRight,hdDownLeft);
  TOnSelectHintDirection=procedure(HintControl:TControl;var HintDirection:THintDirection) of object;  TDanHint = class(TComponent)
  private
    { Private declarations }
    FHintDirection:THintDirection;
    FHintColor:TColor;
    FHintShadowColor:TColor;
    FHintFont:TFont;
    FHintPauseTime:Integer;
    FOnSelectHintDirection:TOnSelectHintDirection;
    procedure SetHintDirection(Value:THintDirection);
    procedure SetHintColor(Value:TColor);
    procedure SetHintShadowColor(Value:TColor);
    procedure SetHintFont(Value:TFont);
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure SetHintPauseTime(Value:Integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure Loaded;override;
    procedure SetNewHintFont;
  published
    { Published declarations }
    property HintDirection:THintDirection read FHintDirection write SetHintDirection default hdUpRight;
    property HintColor:TColor read FHintColor write SetHintColor default clYellow;
    property HintShadowColor:TColor read FHintShadowColor write SetHintShadowColor default clPurple;
    property HintFont:TFont read FHintFont write SetHintFont;
    property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 600;
    property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection;
  end;  TNewHint = class(THintWindow)
  private
    { Private declarations }
    FDanHint:TDanHint;
    FHintDirection:THintDirection;
    procedure SelectProperHintDirection(ARect:TRect);
    procedure CheckUpRight(Spot:TPoint);
    procedure CheckUpLeft(Spot:TPoint);
    procedure CheckDownRight(Spot:TPoint);
    procedure CheckDownLeft(Spot:TPoint);
    function FindDanHint:TDanHint;
    function FindCursorControl:TControl;
  protected
    { Protected declarations }
    procedure Paint;override;
    procedure CreateParams(var Params: TCreateParams);override;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure ActivateHint(Rect: TRect; const AHint: string);override;
    property HintDirection:THintDirection read FHintDirection write FHintDirection default hdUpRight;
  published
    { Published declarations }
  end;procedure Register;implementationconst
   SHADOW_WIDTH=6;
   N_PIXELS=5;
var
   MemBmp:TBitmap;
   UpRect,DownRect:TRect;
   SelectHintDirection:THintDirection;
   ShowPos:TPoint;procedure Register;
begin
  RegisterComponents('Custom', [TDanHint]);
end;procedure TDanHint.SetNewHintFont;
var
   I:Integer;
begin
   for I:=0 to Application.ComponentCount-1 do
      if Application.Components[I] is TNewHint then
         begin
            TNewHint(Application.Components[I]).Canvas.Font.Assign(FHintFont);
            Exit;
         end;
end;constructor TDanHint.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   FHintDirection:=hdUpRight;
   FHintColor:=clYellow;
   { $0080FFFF is Delphi's original setting }
   FHintShadowColor:=clPurple;
   FHintPauseTime:=600;
   Application.HintPause:=FHintPauseTime;
   FHintFont:=TFont.Create;
   FHintFont.Name:='MS Sans Serif';
   FHintFont.Size:=12;
   FHintFont.Color:=clBlue;
   FHintFont.Pitch:=fpDefault;
   FHintFont.Style:=FHintFont.Style+[fsBold,fsItalic];   if not (csDesigning in ComponentState) then
   begin
        HintWindowClass:=TNewHint;
        Application.ShowHint:=not Application.ShowHint;
        Application.ShowHint:=not Application.ShowHint;
        { in TApplication's SetShowHint, the private
          FHintWindow is allocated according to
          HintWindowClass, so here do so actions to
          call SetShowHint and keep ShowHint property
          the same value }
        SetNewHintFont;
   end;
end;destructor TDanHint.Destroy;
begin
   FHintFont.Free;
   inherited Destroy;
end;procedure TDanHint.Loaded;
begin
     if not (csDesigning in ComponentState) then
     begin
          inherited Loaded;
          HintWindowClass:=TNewHint;
          Application.ShowHint:=not Application.ShowHint;
          Application.ShowHint:=not Application.ShowHint;
          { to activate to allocate a new Hint Window }
          SetNewHintFont;
     end;
end;procedure TDanHint.SetHintDirection(Value:THintDirection);
begin
   FHintDirection:=Value;
end;procedure TDanHint.SetHintColor(Value:TColor);
begin
   FHintColor:=Value;
end;procedure TDanHint.SetHintShadowColor(Value:TColor);
begin
   FHintShadowColor:=Value;
end;procedure TDanHint.SetHintFont(Value:TFont);
begin
   FHintFont.Assign(Value);
   Application.ShowHint:=not Application.ShowHint;
   Application.ShowHint:=not Application.ShowHint;
   { to activate to allocate a new Hint Window }
   SetNewHintFont;
end;procedure TDanHint.CMFontChanged(var Message:TMessage);
begin
   inherited;
   Application.ShowHint:=not Application.ShowHint;
   Application.ShowHint:=not Application.ShowHint;
   { to activate to allocate a new Hint Window }
   SetNewHintFont;
end;procedure TDanHint.SetHintPauseTime(Value:Integer);
begin
   if (Value<>FHintPauseTime) then
      begin
         FHintPauseTime:=Value;
         Application.HintPause:=Value;
      end;
end;function TNewHint.FindDanHint:TDanHint;
var
   I:Integer;
begin
   Result:=nil;
   for I:=0 to Application.MainForm.ComponentCount-1 do
      if Application.MainForm.Components[I] is TDanHint then
         begin
            Result:=TDanHint(Application.MainForm.Components[I]);
            Exit;
         end;
end;constructor TNewHint.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   {if (Application<>nil) and (Application.MainForm<>nil) then
      FDanHint:=FindDanHint;}
   ControlStyle:=ControlStyle-[csOpaque];
   with Canvas do
   begin
     { Font.Name:='MS Sans Serif';
      Font.Size:=10;}
      {if (FDanHint<>nil) then Font.Assign(FDanHint.HintFont);}
      Brush.Style:=bsClear;
      Brush.Color:=clBackground;
      Application.HintColor:=clBackground;
   end;
   FHintDirection:=hdUpRight;
end;destructor TNewHint.Destroy;
begin
   inherited Destroy;
end;procedure TNewHint.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    {Style := WS_POPUP or WS_BORDER or WS_DISABLED;}
    Style := Style-WS_BORDER;
    {ExStyle:=ExStyle or WS_EX_TRANSPARENT;}
    {Add the above makes the beneath window overlap hint}
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  end;
end;procedure TNewHint.Paint;
var
  R: TRect;
  CCaption: array[0..255] of Char;
  FillRegion,ShadowRgn:HRgn;
  AP:array[0..2] of TPoint; { Points of the Arrow }
  SP:array[0..2] of TPoint; { Points of the Shadow }
  X,Y:Integer;
  AddNum:Integer; { Added num for hdDownXXX }
begin
      R := ClientRect;
      { R is for Text output }
      Inc(R.Left,5+3);
      Inc(R.Top,3);
      AddNum:=0;
      if FHintDirection>=hdDownRight then AddNum:=15;
      Inc(R.Top,AddNum);      case HintDirection of
         hdUpRight:begin
                      AP[0]:=Point(10,Height-15);
                      AP[1]:=Point(20,Height-15);
                      AP[2]:=Point(0,Height);
                      SP[0]:=Point(12,Height-15);
                      SP[1]:=Point(25,Height-15);
                      SP[2]:=Point(12,Height);
                   end;
         hdUpLeft:begin
                     AP[0]:=Point(Width-SHADOW_WIDTH-20,Height-15);
                     AP[1]:=Point(Width-SHADOW_WIDTH-10,Height-15);
                     AP[2]:=Point(Width-SHADOW_WIDTH,Height);
                     SP[0]:=Point(Width-SHADOW_WIDTH-27,Height-15);
                     SP[1]:=Point(Width-SHADOW_WIDTH-5,Height-15);
                     SP[2]:=Point(Width-SHADOW_WIDTH,Height);
                  end;
         hdDownRight:begin
                        AP[0]:=Point(10,15);
                        AP[1]:=Point(20,15);
                        AP[2]:=Point(0,0);
                        { for hdDownXXX, SP not used now }
                        SP[0]:=Point(12,Height-15);
                        SP[1]:=Point(25,Height-15);
                        SP[2]:=Point(12,Height);
                     end;
         hdDownLeft:begin
                       AP[0]:=Point(Width-SHADOW_WIDTH-20,15);
                       AP[1]:=Point(Width-SHADOW_WIDTH-10,15);
                       AP[2]:=Point(Width-SHADOW_WIDTH,0);
                       { for hdDownXXX, SP not used now }
                       SP[0]:=Point(12,Height-15);
                       SP[1]:=Point(25,Height-15);
                       SP[2]:=Point(12,Height);
                    end;
      end;      { Draw Shadow of the Hint Rect}
      if (FHintDirection<=hdUpLeft) then
         begin
            ShadowRgn:=CreateRoundRectRgn(0+10,0+8,Width,Height-9,8,8);
            { 8 is for RoundRect's corner }
            for X:=Width-SHADOW_WIDTH-8 to Width do
               for Y:=8 to Height-14 do
                  begin
                     if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
                        MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
                  end;
            for X:=10 to Width do
               for Y:=Height-14 to Height-9 do
                  begin
                     if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
                        MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
                  end;
         end
      else           { for hdDownXXX }
         begin
            ShadowRgn:=CreateRoundRectRgn(0+10,0+8+15,Width,Height-2,8,8);
            for X:=Width-SHADOW_WIDTH-8 to Width do
               for Y:=23 to Height-8 do
                  begin
                     if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
                        MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
                  end;
            for X:=10 to Width do
               for Y:=Height-8 to Height-2 do
                  begin
                     if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
                        MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
                  end;
         end;
      DeleteObject(ShadowRgn);      { Draw the shadow of the arrow }
      if (HintDirection<=hdUpLeft) then
         begin
            ShadowRgn:=CreatePolygonRgn(SP,3,WINDING);
            for X:=SP[0].X to SP[1].X do
               for Y:=SP[0].Y to SP[2].Y do
                  begin
                     if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
                        MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
                  end;
            DeleteObject(ShadowRgn);
         end;      { Draw HintRect }
      MemBmp.Canvas.Pen.Color:=clBlack;
      MemBmp.Canvas.Pen.Style:=psSolid;
      MemBmp.Canvas.Brush.Color:=FDanHint.HintColor;      MemBmp.Canvas.Brush.Style:=bsSolid;
      if (FHintDirection<=hdUpLeft) then
         MemBmp.Canvas.RoundRect(0,0,Width-SHADOW_WIDTH,Height-14,9,9)
      else
         MemBmp.Canvas.RoundRect(0,0+AddNum,Width-SHADOW_WIDTH,Height-14+6,9,9);
      { Draw Hint Arrow }
      MemBmp.Canvas.Pen.Color:=FDanHint.HintColor;
      MemBmp.Canvas.MoveTo(AP[0].X,AP[0].Y);
      MemBmp.Canvas.LineTo(AP[1].X,AP[1].Y);
      MemBmp.Canvas.Pen.Color:=clBlack;
      FillRegion:=CreatePolygonRgn(AP,3,WINDING);
      FillRgn(MemBmp.Canvas.Handle,FillRegion,MemBmp.Canvas.Brush.Handle);
      DeleteObject(FillRegion);
      MemBmp.Canvas.LineTo(AP[2].X,AP[2].Y);
      MemBmp.Canvas.LineTo(AP[0].X,AP[0].Y);      { SetBkMode makes DrawText's text be transparent }
      SetBkMode(MemBmp.Canvas.Handle,TRANSPARENT);
      MemBmp.Canvas.Font.Assign(FDanHint.HintFont);
      DrawText(MemBmp.Canvas.Handle, StrPCopy(CCaption, Caption), -1, R,
        DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
      Canvas.CopyMode:=cmSrcCopy;
      Canvas.CopyRect(ClientRect,MemBmp.Canvas,ClientRect);
      MemBmp.Free;
end;procedure TNewHint.CheckUpLeft(Spot:TPoint);
var
   Width,Height:Integer;
begin
   Dec(Spot.Y,N_PIXELS);
   Width:=UpRect.Right-UpRect.Left;
   Height:=UpRect.Bottom-UpRect.Top;
   SelectHintDirection:=hdUpLeft;
   if (Spot.X+SHADOW_WIDTH-Width)<0 then
      begin
         Inc(Spot.Y,N_PIXELS);{back tp original}
         CheckUpRight(Spot);
         Exit;
      end;
   if (Spot.Y-Height)<0 then
      begin
         Inc(Spot.Y,N_PIXELS);
         CheckDownLeft(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
   ShowPos.Y:=Spot.Y-Height;
end;procedure TNewHint.CheckUpRight(Spot:TPoint);
var
   Width,Height:Integer;
begin
   Dec(Spot.Y,N_PIXELS);
   Width:=UpRect.Right-UpRect.Left;
   Height:=UpRect.Bottom-UpRect.Top;
   SelectHintDirection:=hdUpRight;
   if (Spot.X+Width)>Screen.Width then
      begin
         Inc(Spot.Y,N_PIXELS);
         CheckUpLeft(Spot);
         Exit;
      end;
   if (Spot.Y-Height)<0 then
      begin
         Inc(Spot.Y,N_PIXELS);
         CheckDownRight(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X;
   ShowPos.Y:=Spot.Y-Height;
end;procedure TNewHint.CheckDownRight(Spot:TPoint);
var
   Width,Height:Integer;
begin
   Inc(Spot.Y,N_PIXELS*3);
   Width:=DownRect.Right-DownRect.Left;
   Height:=DownRect.Bottom-DownRect.Top;
   SelectHintDirection:=hdDownRight;
   if (Spot.X+Width)>Screen.Width then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckDownLeft(Spot);
         Exit;
      end;
   if (Spot.Y+Height)>Screen.Height then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckUpRight(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X;
   ShowPos.Y:=Spot.Y;
end;procedure TNewHint.CheckDownLeft(Spot:TPoint);
var
   Width,Height:Integer;
begin
   Inc(Spot.Y,N_PIXELS*3);
   Width:=DownRect.Right-DownRect.Left;
   Height:=DownRect.Bottom-DownRect.Top;
   SelectHintDirection:=hdDownLeft;
   if (Spot.X+SHADOW_WIDTH-Width)<0 then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckDownRight(Spot);
         Exit;
      end;
   if (Spot.Y+Height)>Screen.Height then
      begin
         Dec(Spot.Y,N_PIXELS*3);
         CheckUpLeft(Spot);
         Exit;
      end;
   ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
   ShowPos.Y:=Spot.Y;
end;function TNewHint.FindCursorControl:TControl;
begin
   {ControlAtPos}
end;procedure TNewHint.SelectProperHintDirection(ARect:TRect);
var
   Spot:TPoint;
   OldHintDirection,SendHintDirection:THintDirection;
   HintControl:TControl;
begin
   GetCursorPos(Spot);
   HintCOntrol:=FindDragTarget(Spot,True);
   Inc(ARect.Right,10+SHADOW_WIDTH);
   Inc(ARect.Bottom,20);
   UpRect:=ARect;
   Inc(ARect.Bottom,9);
   DownRect:=ARect;
   OldHintDirection:=FDanHint.HintDirection;
   SendHintDirection:=FDanHint.HintDirection;
{ Tricky, why here can't use FDanHint.OnSe...? }
   if Assigned(FDanHint.FOnSelectHintDirection) then
      begin
         FDanHint.FOnSelectHintDirection(HintControl,SendHintDirection);
         FDanHint.HintDirection:=SendHintDirection;
      end;
   case FDanHint.HintDirection of
      hdUpRight:CheckUpRight(Spot);
      hdUpLeft:CheckUpLeft(Spot);
      hdDownRight:CheckDownRight(Spot);
      hdDownLeft:CheckDownLeft(Spot);
   end;
   FDanHint.HintDirection:=OldHintDirection;
end;procedure TNewHint.ActivateHint(Rect: TRect; const AHint: string);
var
   ScreenDC:HDC;
   LeftTop:TPoint;
   tmpWidth,tmpHeight:Integer;
begin
   MemBmp:=TBitmap.Create;
   Caption := AHint;
   { add by Dan from Here }
   FDanHint:=FindDanHint;   SelectProperHintDirection(Rect);
   HintDirection:=SelectHintDirection;
   { if the following changes, make sure to modify
     SelectProperHintDirection also }
   Inc(Rect.Right,10+SHADOW_WIDTH);
   Inc(Rect.Bottom,20);
   if (FHintDirection>=hdDownRight) then Inc(Rect.Bottom,9);
   { to expand the rect }
   tmpWidth:=Rect.Right-Rect.Left;
   tmpHeight:=Rect.Bottom-Rect.Top;
   Rect.Left:=ShowPos.X;
   Rect.Top:=ShowPos.Y;
   Rect.Right:=Rect.Left+tmpWidth;
   Rect.Bottom:=Rect.Top+tmpHeight;
   BoundsRect := Rect;   MemBmp.Width:=Width;
   MemBmp.Height:=Height;   ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);
   LeftTop.X:=0;
   LeftTop.Y:=0;
   LeftTop:=ClientToScreen(LeftTop);
   { use MemBmp to store the original bitmap
     on screen }
   BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,
          LeftTop.X,LeftTop.Y,SRCCOPY);
{   SetBkMode(Canvas.Handle,TRANSPARENT);}   SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0,
     0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
   BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle,
          0,0,SRCCOPY);
   DeleteDC(ScreenDC);
end;  initializationend.

Answer 1

该代码如何使用？比如说我将鼠标移动到一按键，则显示我定义的Hint?

Answer 2

把这个代码安装成组件
放在你的窗体上然后，你的hint自动会改变

Answer 3

我喜欢用LMD，这套控件里边的HINT就不错，可以实现：
椭圆，气泡形，字体大小可变等

Answer 4

书上有，就是那本《Delphi5开发人员指南》 机械工业出版社出版 定价：138.00元
里的第656页里有细说明，  同志不会吧，搞Delphi开发没有这本书怎么混呀……

Answer 5

你去看看《Delphi 4 全面开发》，那套书的配套光盘中直接有一章是介绍这个的，有空间和源码，那可是Borland的工程师写的！

Answer 6

对了还有一本，说的也不错叫《Delphi4从入门到精通》电子工业出版社出版 90.00元
里的272页，多卖几本书吧，学好了书上那些东东你就不会提这种问题了…

Answer 7

  我自己做了漫画形式的HINT，好象没有楼上那位哥们的代码长，比较简单，你也可以从
THintWindow派生

Answer 8

to AutoAsm():能不能将你的代码贴出来啊？ 谁还有其他的方法，希望能够贴出代码！

Answer 9

  最简单的方法是，将Hint作为一个FORM，初始化时设置窗口区域为圆角矩形，下面还要画个尖角出来，然后在FORM上放标签。
  我也想把代码贴出来，可是我在网吧，在宿舍无法上网！