Delphi 如何捕获TTN_LINKCLICK通知？

我试图使用“tooltips\u class32”实现一个简单的气球提示。事实上，除了气球上的链接，所有行为都是正确的

我的引出序号被正确创建，我可以看到链接，但是当我单击链接时，什么也没有发生

我试图在两个窗口过程中捕获TTN_LINKCLICK通知。我的工具提示和我的工具提示的父窗口之一

我知道这个通知是以WM_NOTIFY的形式发送的，但是当我点击链接时什么也没做

那么，如何捕获TTN_LINKCLICK通知呢？如何使它在Delphi上工作

下面是我的TKRKBalloonHint组件的完整代码

unit KRKBalloonHint;

interface

uses
  SysUtils, Classes, Graphics, ExtCtrls, Types, CommCtrl, Controls, Messages,
  Windows;

type
  TTipIcon = (tiNone,tiInfo,tiWarning,tiError,tiInfoLarge,tiWarningLarge,tiErrorLarge);

  TTipAlignment = (taTopLeft,taTopMiddle,taTopRight,taLeftMiddle,taRightMiddle,taBottomLeft,taBottomMiddle,taBottomRight,taCustom);

  TMaxWidth = 0..320;

  TKRKBalloonHintOption = (kbhoActivateOnShow, kbhoSetFocusToAssociatedWinContronOnDeactivate, kbhoHideOnDeactivate, kbhoHideWithEnter, kbhoHideWithEsc, kbhoSelectAllOnFocus);
  TKRKBalloonHintOptions = set of TKRKBalloonHintOption;

  TKRKBalloonHint = class(TComponent)
  private
    FParentHandle: HWND;
    FAutoGetTexts: Boolean;
    FMaxWidth: TMaxWidth;
    FBackColor: TColor;
    FForeColor: TColor;
    FVisibleTime: Word;
    FDelayTime: Word;
    FTipHandle: THandle;
    FAssociatedWinControl: TWinControl;
    FTipTitle: String;
    FTipText: String;
    FTipIcon: TTipIcon;
    FTipAlignment: TTipAlignment;
    FShowWhenRequested: Boolean;
    FCentered: Boolean;
    FForwardMessages: Boolean;
    FAbsolutePosition: Boolean;
    FShowCloseButton: Boolean;
    FParseLinks: Boolean;
    FFont: TFont;
    FPosition: TPoint;
    FCustomXPosition: Word;
    FCustomYPosition: Word;
    FToolInfo: TToolInfo;
    FOptions: TKRKBalloonHintOptions;

    FOnMouseDown: TMouseEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;

    procedure SetMaxWidth(const Value: TMaxWidth);
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetDelayTime(const Value: Word);
    procedure SetTipIcon(const Value: TTipIcon);
    procedure SetTipText(const Value: String);
    procedure SetTipTitle(const Value: String);
    procedure SetVisibleTime(const Value: Word);
    procedure SetTipAlignment(const Value: TTipAlignment);
    procedure SetPosition(const Value: TPoint);
    procedure SetCustomXPosition(const Value: Word);
    procedure SetCustomYPosition(const Value: Word);
    procedure SetAbsolutePosition(const Value: Boolean);
    procedure SetShowCloseButton(const Value: Boolean);
    procedure SetFont(const Value: TFont);
    procedure SetAssociatedWinControl(const Value: TWinControl);
    procedure SetAutoGetTexts(const Value: Boolean);
    procedure SetParseLinks(const Value: Boolean);
    procedure SetCentered(const Value: Boolean);
    procedure SetForwardMessages(const Value: Boolean);
    procedure SetShowWhenRequested(const Value: Boolean);
    procedure DoFontChange(Sender: TObject);
    procedure DestroyToolTip;
    procedure CreateToolTip;
    procedure UnlinkToolTip;
    procedure LinkToolTip;
    procedure RefreshToolTip;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show(TipAlignment: TTipAlignment); overload;
    procedure Show; overload;
    procedure Show(X, Y: Word); overload;
    procedure Hide;
    procedure Move(X, Y: Word);
    property Handle: THandle read FTipHandle;
    property Position: TPoint read FPosition;
  published
    property ParseLinks: Boolean read FParseLinks write SetParseLinks default False;
    property AutoGetTexts: Boolean read FAutoGetTexts write SetAutoGetTexts default False;
    property AssociatedWinControl: TWinControl read FAssociatedWinControl write SetAssociatedWinControl;
    property MaxWidth: TMaxWidth read FMaxWidth write SetMaxWidth default 0;
    property BackColor: TColor read FBackColor write SetBackColor default $00E1FFFF;
    property ForeColor: TColor read FForeColor write SetForeColor default $00000000;
    property VisibleTime: Word read FVisibleTime write SetVisibleTime default 3000;
    property DelayTime: Word read FDelayTime write SetDelayTime default 1000;
    property TipTitle: String read FTipTitle write SetTipTitle;
    property TipText: String read FTipText write SetTipText;
    property TipIcon: TTipIcon read FTipIcon write SetTipIcon default tiInfo;
    property TipAlignment: TTipAlignment read FTipAlignment write SetTipAlignment default taTopLeft;
    property CustomXPosition: Word read FCustomXPosition write SetCustomXPosition default 0;
    property CustomYPosition: Word read FCustomYPosition write SetCustomYPosition default 0;
    property ShowWhenRequested: Boolean read FShowWhenRequested write SetShowWhenRequested default True;
    property Centered: Boolean read FCentered write SetCentered default False;
    property ForwardMessages: Boolean read FForwardMessages write SetForwardMessages default False;
    property AbsolutePosition: Boolean read FAbsolutePosition write SetAbsolutePosition default False;
    property ShowCloseButton: Boolean read FShowCloseButton write SetShowCloseButton default False;
    property Font: TFont read FFont write SetFont;
    property Options: TKRKBalloonHintOptions read FOptions write FOptions default [];
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  end;

implementation

const
  TOOLTIPS_CLASS = 'tooltips_class32';
  TTM_SETTITLE = (WM_USER + 32);
  TTS_BALLOON = $40;
  TTS_CLOSE = $80;
  TTF_PARSELINKS = $1000;
  TTN_LINKCLICK = TTN_FIRST - 3;

var
  OriginalToolTipWNDPROC: Pointer = nil;

function NewToolTipWNDPROC(aWindowHandle: HWND; aMessage: UINT; aWParam: WPARAM; aLParam: LPARAM): LRESULT; stdcall;
var
  ShiftState: TShiftState;
  Button: TMouseButton;
  KRBH: TKRKBalloonHint;
begin
  Button := mbLeft;

  KRBH := TKRKBalloonHint(GetWindowLong(aWindowHandle,GWL_USERDATA));

  if KRBH.FShowWhenRequested then
    case aMessage of
      WM_KEYUP:
        case aWParam of
          13:
            if kbhoHideWithEnter in KRBH.Options then
              KRBH.Hide;
          27:
            if kbhoHideWithEsc in KRBH.Options then
              KRBH.Hide;
        end;
      WM_MOUSEMOVE:
        if Assigned(KRBH.FOnMouseMove) then
        begin
          ShiftState := [];

          if (MK_CONTROL and aWParam) = MK_CONTROL  then
            ShiftState := ShiftState + [ssCtrl];

          if (MK_SHIFT and aWParam) = MK_SHIFT then
            ShiftState := ShiftState + [ssShift];

          if GetKeyState(VK_MENU) < 0 then
            ShiftState := ShiftState + [ssAlt];

          if (MK_LBUTTON and aWParam) = MK_LBUTTON then
            ShiftState := ShiftState + [ssLeft];

          if (MK_MBUTTON and aWParam) = MK_MBUTTON then
            ShiftState := ShiftState + [ssMiddle];

          if (MK_RBUTTON and aWParam) = MK_RBUTTON then
            ShiftState := ShiftState + [ssRight];

          KRBH.FOnMouseMove(KRBH,ShiftState,LOWORD(aLParam),HIWORD(aLParam));
        end;

      WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN:
        if Assigned(KRBH.FOnMouseDown) then
        begin
          ShiftState := [];

          if (MK_CONTROL and aWParam) = MK_CONTROL  then
            ShiftState := ShiftState + [ssCtrl];

          if (MK_SHIFT and aWParam) = MK_SHIFT then
            ShiftState := ShiftState + [ssShift];

          if GetKeyState(VK_MENU) < 0 then
            ShiftState := ShiftState + [ssAlt];

          if (MK_LBUTTON and aWParam) = MK_LBUTTON then
          begin
            ShiftState := ShiftState + [ssLeft];
            Button := mbLeft;
          end
          else if (MK_MBUTTON and aWParam) = MK_MBUTTON then
          begin
            ShiftState := ShiftState + [ssMiddle];
            Button := mbMiddle;
          end
          else if (MK_RBUTTON and aWParam) = MK_RBUTTON then
          begin
            ShiftState := ShiftState + [ssRight];
            Button := mbRight;
          end;

            KRBH.FOnMouseDown(KRBH,Button,ShiftState,LOWORD(aLParam),HIWORD(aLParam));
        end;

      WM_LBUTTONUP, WM_MBUTTONUP, WM_RBUTTONUP:
        if Assigned(KRBH.FOnMouseUp) then
        begin
          ShiftState := [];

          if (MK_CONTROL and aWParam) = MK_CONTROL  then
            ShiftState := ShiftState + [ssCtrl];

          if (MK_SHIFT and aWParam) = MK_SHIFT then
            ShiftState := ShiftState + [ssShift];

          if GetKeyState(VK_MENU) < 0 then
            ShiftState := ShiftState + [ssAlt];

          if (MK_LBUTTON and aWParam) = MK_LBUTTON then
          begin
            ShiftState := ShiftState + [ssLeft];
            Button := mbLeft;
          end;

          if (MK_MBUTTON and aWParam) = MK_MBUTTON then
          begin
            ShiftState := ShiftState + [ssMiddle];
            Button := mbMiddle;
          end;

          if (MK_RBUTTON and aWParam) = MK_RBUTTON then
          begin
            ShiftState := ShiftState + [ssRight];
            Button := mbRight;
          end;

          KRBH.FOnMouseUp(KRBH,Button,ShiftState,LOWORD(aLParam),HIWORD(aLParam));
        end;
        WM_KILLFOCUS:
        begin
          if Assigned(KRBH.AssociatedWinControl) and (kbhoSetFocusToAssociatedWinContronOnDeactivate in KRBH.Options) then
            SetFocus(KRBH.AssociatedWinControl.Handle);

          if Assigned(KRBH.AssociatedWinControl) and (kbhoSelectAllOnFocus in KRBH.Options) then
            SendMessage(KRBH.AssociatedWinControl.Handle, EM_SETSEL, 0, -1);

          if kbhoHideOnDeactivate in KRBH.Options then
            KRBH.Hide;
        end;
    end;

  Result := CallWindowProc(OriginalToolTipWNDPROC,aWindowHandle,aMessage,aWParam,aLParam);
end;

{ TKRKBalloonHint }

constructor TKRKBalloonHint.Create(aOwner: TComponent);
begin
  inherited;
  FParentHandle := 0;

  if Assigned(aOwner) and (aOwner is TWinControl) then
    FParentHandle := TWinControl(aOwner).Handle;

  FMaxWidth  := 0;
  FBackColor := $00E1FFFF;
  FForeColor := $00000000;
  FOptions := [];

  FVisibleTime := 3000;
  FDelayTime := 1000;
  FTipHandle := 0;
  FAssociatedWinControl := nil;
  FTipTitle := 'Balão sem título';
  FTipText := 'Você esqueceu de por um texto. Configure a propriedade TipText corretamente';
  FAutoGetTexts := False;
  FTipIcon := tiInfo;
  FTipAlignment := taTopLeft;
  FShowWhenRequested := True;
  FCentered := False;
  FForwardMessages := False;
  FAbsolutePosition := False;
  FShowCloseButton := False;
  FParseLinks := False;
  FFont := TFont.Create;

  FFont.OnChange := DoFontChange;
  FPosition := Point(0,0);
  FCustomXPosition := 0;
  FCustomYPosition := 0;

  ZeroMemory(@FToolInfo, SizeOf(TToolInfo));

  with FToolInfo do
  begin
    cbSize := SizeOf(TToolInfo);

    if FAbsolutePosition then
      uFlags := uFlags or TTF_ABSOLUTE;

    if FCentered then
      uFlags := uFlags or TTF_CENTERTIP;

    if FParseLinks then
      uFlags := uFlags or TTF_PARSELINKS;

    if FShowWhenRequested then
      FToolInfo.uFlags := FToolInfo.uFlags or TTF_TRACK
    else
      FToolInfo.uFlags := FToolInfo.uFlags or TTF_SUBCLASS;

    if FForwardMessages then
      uFlags := uFlags or TTF_TRANSPARENT;
  end;

  CreateToolTip;
end;

destructor TKRKBalloonHint.Destroy;
begin
  FFont.Free;
  DestroyToolTip;
  inherited;
end;

procedure TKRKBalloonHint.DestroyToolTip;
begin
  if FTipHandle <> 0 then
    DestroyWindow(FTipHandle);
end;

procedure TKRKBalloonHint.CreateToolTip;
var
  Style: Cardinal;
begin
  Style := TTS_NOPREFIX or TTS_BALLOON;

  if FShowCloseButton then
    Style := Style or TTS_CLOSE;

  FTipHandle := CreateWindowEx(WS_EX_NOACTIVATE or WS_EX_TOPMOST,TOOLTIPS_CLASS,nil,Style,0,0,0,0,FParentHandle,0,0,nil);

  SetWindowLong(FTipHandle,GWL_USERDATA,Integer(Self));

  OriginalToolTipWNDPROC := Pointer(SetWindowLong(FTipHandle,GWL_WNDPROC,LongInt(@NewToolTipWNDPROC)));

  LinkToolTip;
end;

procedure TKRKBalloonHint.LinkToolTip;
begin
  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_ADDTOOL,0,LPARAM(@FToolInfo));
end;

procedure TKRKBalloonHint.UnlinkToolTip;
begin
  if FTipHandle <> 0 then
  begin
    Hide;
    SendMessage(FTipHandle,TTM_DELTOOL,0,LPARAM(@FToolInfo));
  end;
end;

procedure TKRKBalloonHint.SetShowWhenRequested(const Value: Boolean);
begin
  UnlinkToolTip;
  try
    FShowWhenRequested := Value;

    FToolInfo.uFlags := FToolInfo.uFlags or TTF_SUBCLASS or TTF_TRACK;

    if not FShowWhenRequested then
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_TRACK // Tira TTF_TRACK e mantém TTF_SUBCLASS
    else
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_SUBCLASS; // Tira TTF_SUBCLASS e mantém TTF_TRACK
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.SetForwardMessages(const Value: Boolean);
begin
  UnlinkToolTip;
  try
    FForwardMessages := Value;

    FToolInfo.uFlags := FToolInfo.uFlags or TTF_TRANSPARENT;

    if not FForwardMessages then
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_TRANSPARENT;
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.SetCentered(const Value: Boolean);
begin
  UnlinkToolTip;
  try
    FCentered := Value;

    FToolInfo.uFlags := FToolInfo.uFlags or TTF_CENTERTIP;

    if not FCentered then
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_CENTERTIP;
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.SetForeColor(const Value: TColor);
begin
  FForeColor := Value;

  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_SETTIPTEXTCOLOR,FForeColor,0);
end;

procedure TKRKBalloonHint.SetBackColor(const Value: TColor);
begin
  FBackColor := Value;

  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_SETTIPBKCOLOR,FBackColor,0);
end;

procedure TKRKBalloonHint.SetMaxWidth(const Value: TMaxWidth);
begin
  FMaxWidth := Value;

  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_SETMAXTIPWIDTH,0,FMaxWidth);

  RefreshToolTip;
end;

procedure TKRKBalloonHint.SetVisibleTime(const Value: Word);
begin
  FVisibleTime := Value;

  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_SETDELAYTIME,TTDT_AUTOPOP,Value);
end;

procedure TKRKBalloonHint.SetDelayTime(const Value: Word);
begin
  FDelayTime := Value;

  if FTipHandle <> 0 then
     SendMessage(FTipHandle,TTM_SETDELAYTIME,TTDT_INITIAL,Value);
end;

procedure TKRKBalloonHint.SetTipTitle(const Value: String);
var
  Title: LPCSTR;
begin
  if not FAutoGetTexts then
  begin
    FTipTitle := Value;

    if (FTipHandle <> 0) and (Trim(FTipTitle) <> '') then
    begin
      GetMem(Title,256);
      try
        StrPCopy(Title,AnsiString(FTipTitle));
        SendMessage(FTipHandle,TTM_SETTITLE,WPARAM(FTipIcon),LPARAM(Title));
      finally
        FreeMem(Title);
      end;
    end;

    RefreshToolTip;
  end
  else if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    raise Exception.Create('Não é possível mudar o título da dica pois a propriedade AutoGetTexts está ativada. Para poder mudar o título da dica, primeiramente desative a propriedade AutoGetTexts');
end;

procedure TKRKBalloonHint.SetTipText(const Value: String);
begin
  if not FAutoGetTexts then
  begin
    FTipText := Value;

    FToolInfo.lpszText := PChar(FTipText);

    if FTipHandle <> 0 then
      SendMessage(FTipHandle,TTM_UPDATETIPTEXT,0,LPARAM(@FToolInfo));
  end
  else if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    raise Exception.Create('Não é possível mudar o texto da dica pois a propriedade AutoGetTexts está ativada. Para poder mudar o texto da dica, primeiramente desative a propriedade AutoGetTexts');
end;

procedure TKRKBalloonHint.SetTipIcon(const Value: TTipIcon);
var
  Title: LPCSTR;
begin
  FTipIcon := Value;

  if (FTipHandle <> 0) and (Trim(FTipTitle) <> '') then
  begin
    GetMem(Title,256);
    try
      StrPCopy(Title,AnsiString(FTipTitle));
      SendMessage(FTipHandle,TTM_SETTITLE,WPARAM(FTipIcon),LPARAM(Title));
    finally
      FreeMem(Title);
    end;
  end;

  RefreshToolTip;
end;

procedure TKRKBalloonHint.SetTipAlignment(const Value: TTipAlignment);
var
  TmpPoint: TPoint;
begin
  FTipAlignment := Value;

  if not FShowWhenRequested then
    Exit;

  if (FToolInfo.hwnd <> 0) and (FTipHandle <> 0) then
  begin
    GetClientRect(FToolInfo.hwnd,FToolInfo.Rect);

    ClientToScreen(FToolInfo.hwnd,FToolInfo.Rect.TopLeft);
    FToolInfo.Rect.Right := FToolInfo.Rect.Left + FToolInfo.Rect.Right;
    FToolInfo.Rect.Bottom := FToolInfo.Rect.Top + FToolInfo.Rect.Bottom;

    case Value of
      taTopMiddle:
      begin
        TmpPoint.X := (FToolInfo.Rect.Left + FToolInfo.Rect.Right) div 2;
        TmpPoint.Y := FToolInfo.Rect.Top;
      end;
      taTopRight:
      begin
        TmpPoint.X := FToolInfo.Rect.Right;
        TmpPoint.Y := FToolInfo.Rect.Top;
      end;
      taLeftMiddle:
      begin
        TmpPoint.X := FToolInfo.Rect.Left;
        TmpPoint.Y := (FToolInfo.Rect.Top + FToolInfo.Rect.Bottom) div 2;
      end;
      taRightMiddle:
      begin
        TmpPoint.X := FToolInfo.Rect.Right;
        TmpPoint.Y := (FToolInfo.Rect.Top + FToolInfo.Rect.Bottom) div 2;
      end;
      taBottomLeft:
      begin
        TmpPoint.X := FToolInfo.Rect.Left;
        TmpPoint.Y := FToolInfo.Rect.Bottom;
      end;
      taBottomMiddle:
      begin
        TmpPoint.X := (FToolInfo.Rect.Left + FToolInfo.Rect.Right) div 2;
        TmpPoint.Y := FToolInfo.Rect.Bottom;
      end;
      taBottomRight:
      begin
        TmpPoint.X := FToolInfo.Rect.Right;
        TmpPoint.Y := FToolInfo.Rect.Bottom;
      end;
      taTopLeft:
      begin
        TmpPoint.X := FToolInfo.Rect.Left;
        TmpPoint.Y := FToolInfo.Rect.Top;
      end;
      else { taCustom }
        TmpPoint := Point(FCustomXPosition,FCustomYPosition);
    end;

    SetPosition(TmpPoint);
  end;
end;

procedure TKRKBalloonHint.SetPosition(const Value: TPoint);
begin
  FPosition := Value;

   if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_TRACKPOSITION,0,MakeLong(FPosition.X,FPosition.Y));
end;

procedure TKRKBalloonHint.SetAbsolutePosition(const Value: Boolean);
begin
  UnlinkToolTip;
  try
    FAbsolutePosition := Value;

    FToolInfo.uFlags := FToolInfo.uFlags or TTF_ABSOLUTE; { Adiciona o flag }

    if not FAbsolutePosition then
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_ABSOLUTE; { Retira o flag }
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.SetShowCloseButton(const Value: Boolean);
begin
  FShowCloseButton := Value;

  if FTipHandle <> 0 then
  begin
    SetWindowLong(FTipHandle,GWL_STYLE,GetWindowLong(FTipHandle,GWL_STYLE) or TTS_CLOSE);

    if not FShowCloseButton then
      SetWindowLong(FTipHandle,GWL_STYLE,GetWindowLong(FTipHandle,GWL_STYLE) xor TTS_CLOSE);

    RefreshToolTip;
  end;
end;

procedure TKRKBalloonHint.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);

  if FTipHandle <> 0 then
    SendMessage(FTipHandle,WM_SETFONT,FFont.Handle,1);
end;

procedure TKRKBalloonHint.SetAssociatedWinControl(const Value: TWinControl);
begin
  UnlinkToolTip;
  try
    FAssociatedWinControl := Value;

    if Assigned(FAssociatedWinControl) then
    begin
      FToolInfo.hwnd := FAssociatedWinControl.Handle;
      SetAutoGetTexts(FAutoGetTexts);
      SetTipAlignment(FTipAlignment);
    end;
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.SetAutoGetTexts(const Value: Boolean);
var
  Title: LPCSTR;
  i: Byte;
begin
    FAutoGetTexts := Value;

  if FAutoGetTexts and Assigned(FAssociatedWinControl) then
  begin
    FTipTitle := 'Controle associado sem hint';
    FTipText  := 'AutoGetTexts está ativo mas o controle associado não contém hint';
    FTipIcon  := tiInfo;

    if Trim(FAssociatedWinControl.Hint) <> '' then
      with TStringList.Create do
        try
          Text := StringReplace(Trim(FAssociatedWinControl.Hint),'|',#13#10,[rfReplaceAll]);
          for i := 0 to Pred(Count) do
            case i of
              0: FTipTitle := Strings[0];
              1: FTipText  := Strings[1];
              2: FTipIcon  := TTipIcon(StrToIntDef(Strings[2],0));
            end;
        finally
          Free;
        end;

    FToolInfo.lpszText := PWideChar(FTipText);

    if FTipHandle <> 0 then
    begin
      GetMem(Title,256);
      try
        StrPCopy(Title,AnsiString(FTipTitle));
        SendMessage(FTipHandle,TTM_SETTITLE,WPARAM(FTipIcon),LPARAM(Title));
      finally
        FreeMem(Title);
      end;
      SendMessage(FTipHandle,TTM_UPDATETIPTEXT,0,LPARAM(@FToolInfo));
    end;
  end;
end;

procedure TKRKBalloonHint.SetParseLinks(const Value: Boolean);
begin
  UnlinkToolTip;
  try
    FParseLinks := Value;

    FToolInfo.uFlags := FToolInfo.uFlags or TTF_PARSELINKS; { Adiciona o flag }

    if not FParseLinks then
      FToolInfo.uFlags := FToolInfo.uFlags xor TTF_PARSELINKS; { Retira o flag }
  finally
    LinkToolTip;
  end;
end;

procedure TKRKBalloonHint.Show;
begin
  if FTipHandle <> 0 then
  begin
    SendMessage(FTipHandle,TTM_TRACKACTIVATE,1,LPARAM(@FToolInfo));

    if kbhoActivateOnShow in FOptions then
      SetForegroundWindow(FTipHandle);
  end
  else
    raise Exception.Create('Não é possível exibir o balão, pois o mesmo não foi criado. Use o método CreateToolTip antes de chamar o método Show');
end;

procedure TKRKBalloonHint.Show(TipAlignment: TTipAlignment);
begin
  SetTipAlignment(TipAlignment);
  Show;
end;

procedure TKRKBalloonHint.Show(X,Y: Word);
begin
  SetPosition(Point(X,Y));
  Show;
end;

procedure TKRKBalloonHint.Move(X,Y: Word);
var
  TmpRect: TRect;
begin
   if FTipHandle <> 0 then
  begin
    GetClientRect(FTipHandle,TmpRect);
    MoveWindow(FTipHandle,X,Y,TmpRect.right,TmpRect.bottom,True);
  end;
end;

procedure TKRKBalloonHint.Hide;
begin
  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_TRACKACTIVATE,0,LPARAM(@FToolInfo));
end;

procedure TKRKBalloonHint.RefreshToolTip;
begin
  if FTipHandle <> 0 then
    SendMessage(FTipHandle,TTM_UPDATE,0,0);
end;

procedure TKRKBalloonHint.SetCustomXPosition(const Value: Word);
begin
  FCustomXPosition := Value;
end;

procedure TKRKBalloonHint.SetCustomYPosition(const Value: Word);
begin
  FCustomYPosition := Value;
end;

procedure TKRKBalloonHint.DoFontChange(Sender: TObject);
begin
  SetFont(FFont);
end;

end.

当我点击链接时，showmessage从未触发。现在该怎么办？

我将重定向关联控件的，并在出现带有通知的消息时触发事件。所以我会这样做。

无论如何，尽管代码可读性很好，但您在其中有一些小问题。例如，在

SetAutoGetTexts

中，您应该在迭代之前检查字符串列表是否包含某些项，如果

FAssociatedWinControl.Hint

为空，则会失败；）

现在，您将发布工具提示链接单击触发的

OnLinkClick

事件。
以下是运行时使用的示例：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, KRKBalloonHint;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    BalloonHint: TKRKBalloonHint;
    procedure OnLinkClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnLinkClick(Sender: TObject);
begin
  ShowMessage('Link clicked !');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BalloonHint.TipText := 'This is a <A href="www.google.com">link</A>.';
  BalloonHint.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BalloonHint := TBalloonHint.Create(Self);
  BalloonHint.ParseLinks := True;
  BalloonHint.OnLinkClick := OnLinkClick;
  BalloonHint.AssociatedWinControl := Edit1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BalloonHint.Free;
end;

end.

单元1；
接口
使用
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、stdctrl、KRKBalloonHint；
类型
TForm1=类（TForm）
编辑1：TEdit；
按钮1:t按钮；
程序按钮1点击（发送方：ToObject）；
过程表单创建（发送方：ToObject）；
销毁程序表（发送方：TObject）；
私有的
气球提示：TKRKBalloonHint；
过程OnLinkClick（发送方：TObject）；
公众的
{公开声明}
结束；
变量
表1:TForm1；
实施
{$R*.dfm}
过程TForm1.OnLinkClick（发送方：TObject）；
开始
ShowMessage（'单击链接！'）；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
开始
ballohint.TipText:=“这是一个。”；
气球提示。显示；
结束；
过程TForm1.FormCreate（发送方：TObject）；
开始
BallooHint:=TBalloonHint.Create（Self）；
BallooHint.ParseLinks:=True；
BallookHint.OnLinkClick:=OnLinkClick；
BallooHint.AssociatedWinControl:=Edit1；
结束；
程序TForm1.FormDestroy（发送方：ToObject）；
开始
气球提示。免费；
结束；
结束。

也许向我们展示您目前拥有的代码将有助于您获得关于如何继续或尝试什么的建议。您是否包含comctl32 v6清单？@marjannema-您好。今晚我会把密码贴在这里。现在我正在工作，我没有meAlso的代码，“父窗口”可能不同于“父窗体”，除非为窗体显示提示。例如，如果为按钮或面板显示，按钮/面板可能是父级。通知消息发送到窗口，因此在本例中发送到

关联的WinControl

。感谢您的称赞（是的，我喜欢可读代码，因为我的内存非常弱；））和回答。我以后再试试。感谢FAssociatedWinControl.Hint上的警告。这是一种非常有趣的窗口过程子类化方法。从现在起，我可能会使用这种方法，因为通知消息会发送到您的

关联WinControl

，对每个控件进行子类划分会很复杂。重定向是非常安全的，我已经多次看到这种做法。事实上，这只是改变了方法指针。太好了！另一件事：TTN_LINKCLICK设置为AssociatedWinControl（ftoolnfo.hwnd）？Windows SDK帮助说明此通知发送到父窗口而不是FToolInfo.hwnd。您在哪里找到此信息？我找不到任何官方资源来描述这一点。我知道的唯一一件事是，当您将设置为某个窗口控件时，该控件将接收这些通知（这对我来说是有效的）。我尝试将其设置为0，并捕获来自

所有者

甚至来自

父级

（将祖先更改为

TControl

）的通知，但没有收到任何通知。

type
  TKRKBalloonHint = class(TComponent)
  private
    ...
    FOnLinkClick: TNotifyEvent;
    FOldWindowProc: TWndMethod;
    procedure WinControlWndProc(var AMessage: TMessage);
    procedure SetAssociatedWinControl(const Value: TWinControl);
  published
    ...
    property OnLinkClick: TNotifyEvent read FOnLinkClick write FOnLinkClick;
  end;

procedure TKRKBalloonHint.WinControlWndProc(var AMessage: TMessage);
begin
  if AMessage.Msg = WM_NOTIFY then
    if Assigned(TWMNotify(AMessage).NMHdr) and (TWMNotify(AMessage).NMHdr^.code = TTN_LINKCLICK) then
      if Assigned(FOnLinkClick) then
        FOnLinkClick(Self);

  FOldWindowProc(AMessage);
end;

procedure TKRKBalloonHint.SetAssociatedWinControl(const Value: TWinControl);
begin
  UnlinkToolTip;
  try
    if Assigned(FAssociatedWinControl) then
      FAssociatedWinControl.WindowProc := FOldWindowProc;

    FAssociatedWinControl := Value;

    if Assigned(FAssociatedWinControl) then
    begin
      FToolInfo.hwnd := FAssociatedWinControl.Handle;
      FOldWindowProc := FAssociatedWinControl.WindowProc;
      FAssociatedWinControl.WindowProc := WinControlWndProc;
      SetAutoGetTexts(FAutoGetTexts);
      SetTipAlignment(FTipAlignment);
    end;
  finally
    LinkToolTip;
  end;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, KRKBalloonHint;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    BalloonHint: TKRKBalloonHint;
    procedure OnLinkClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnLinkClick(Sender: TObject);
begin
  ShowMessage('Link clicked !');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BalloonHint.TipText := 'This is a <A href="www.google.com">link</A>.';
  BalloonHint.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BalloonHint := TBalloonHint.Create(Self);
  BalloonHint.ParseLinks := True;
  BalloonHint.OnLinkClick := OnLinkClick;
  BalloonHint.AssociatedWinControl := Edit1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BalloonHint.Free;
end;

end.