德尔福7中没有XP清单的气球提示

Question

我们使用代码http://www.delphitricks.com/source-code/forms/show_balloon_tooltips_in_my_delphi_program.html来调用TEdit控件上的气球提示。

问题是只有当鼠标指针位于控件上时才会出现提示，因此OnEnter或OnChange上应显示提示的代码不会触发。我们假设我们使用的代码与仅在鼠标超过控件时才出现的标准提示类似，但我们需要它显示在当前鼠标的任何位置。

仅供参考，这样我们就可以模拟进入输入密码的TEdit控件时发生的情况，并且如果启用了大写锁定，则会出现警告。可悲的是，我们不能使用xpmanifest自动执行此操作。

如果鼠标没有结束，我们如何才能显示提示？

感谢您一如既往的帮助。

Answer 1

巧合的是，我只是想做一些非常相似，并结束了创建我自己的类从 T形 TGraphicControl TCustomPanel（使用TCustomPanel因为TGraphicControl永远不能拥有它的Z顺序之上的任何其他窗口的控件）派生但使用TShape的一些Paint代码，覆盖Paint方法（添加一个调用Canvas.TextOut）并添加一个Text属性和其他各种东西，即单击该工具并关闭它。

用途（其中edt1是一个编辑控件附加提示）：

ToolTip:=TlbrToolTip.Create(edt1); 
ToolTip.Parent:=edt.Parent; 
ToolTip.Text:='This is the tooltip text'; 

在自己需要的任何编辑的事件再加入ToolTip.Show，Tooltip.Hide隐藏它。

我添加了一个显示属性，我用它来表示该提示已在somepoint被证明，然后添加一个Tooltip.Reset（其中隐藏的提示，并设置Shown为false）打电话到相关的事件的OnExit控制。这样，如果用户点击工具提示隐藏它，我可以控制它，以便提示不会弹出，除非控件失去焦点。这不是一个全部的歌唱和舞蹈控制，但这是我的目的，也许对别人有用。

type TlbrToolTip = class (TCustomPanel) 
    private 
     fOwner: TControl; 
     fPen: TPen; 
     fBrush: TBrush; 
     fText: String; 
     fShown: Boolean; 
     procedure SetText(const Value: String); 
    protected 
     procedure Paint; override; 
     procedure PerformClick(Sender: TObject); 
    public 
     constructor Create(aOwner: TComponent); override; 
     destructor Destroy; override; 
     property Shown: Boolean read fShown; //If true then at some point the tooltip has been shown. 
    published 
     procedure StyleChanged(Sender: TObject); 
     procedure Show; 
     procedure Hide; 
     procedure Reset(Sender: TObject); //Sets shown to false. 
     property Text: String read fText write SetText; 
     property OnClick; 
    end; 

implementation 

{ TlbrToolTip } 

procedure TlbrToolTip.PerformClick(Sender: TObject); 
begin 
    Visible:=False; 
end; 

constructor TlbrToolTip.Create(aOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    visible:=false; 
    ControlStyle := ControlStyle + [csReplicatable, csNoDesignVisible]; 
    fOwner:=(aOwner as TControl); 
    Width := 65; 
    Height := 30; 
    FPen := TPen.Create; 
    FPen.OnChange := StyleChanged; 
    FBrush := TBrush.Create; 
    FBrush.Color:=clInfoBk; 
    FBrush.OnChange := StyleChanged; 
    OnClick:=PerformClick; 
end; 

destructor TlbrToolTip.Destroy; 
begin 
    FPen.Free; 
    FBrush.Free; 
    inherited Destroy; 
end; 

procedure TlbrToolTip.Hide; 
begin 
    visible:=False; 
end; 

procedure TlbrToolTip.Paint; 
var 
    X, Y, W, H, S, tw, th: Integer; 
begin 
    with Canvas do 
    begin 
    Pen := FPen; 
    Brush := FBrush; 
    X := Pen.Width div 2; 
    Y := X; 
    W := Width - Pen.Width + 1; 
    H := Height - Pen.Width + 1; 
    if Pen.Width = 0 then 
    begin 
     Dec(W); 
     Dec(H); 
    end; 
    if W < H then S := W else S := H; 
    RoundRect(X, Y, X + W, Y + H, S div 4, S div 4); 
    th:=TextHeight(fText); 
    tw:=TextWidth(fText); 
    TextOut((Self.width-tw) div 2,(Self.Height-th) div 2,fText); 
    end; 
end; 

procedure TlbrToolTip.Reset(Sender: TObject); 
begin 
    visible:=False; 
    fShown:=False; 
end; 

procedure TlbrToolTip.SetText(const Value: String); 
begin 
    fText := Value; 
    Width:=Max(65,6+canvas.TextWidth(fText)); 
    Invalidate; 
end; 

procedure TlbrToolTip.Show; 
var 
    l,t: integer; 
begin 
    if not fShown and not (csDesigning in ComponentState) then 
    begin 
    l:=fOwner.Left; 
    t:=fOwner.Top+fOwner.Height+2; 
    if (l+self.Width>fOwner.Parent.ClientWidth) then 
     l:=fOwner.Parent.ClientWidth-self.Width-(fOwner.Width-fOwner.ClientWidth); 
    if (t+self.Height>fOwner.Parent.ClientHeight) then 
     t:=fOwner.Top-self.Height-2; 
    Left:=l; 
    Top:=t; 
    BringToFront; 
    Visible:=true; 
    end; 
    fShown:=True; 
end; 

procedure TlbrToolTip.StyleChanged(Sender: TObject); 
begin 
    Invalidate; 
end;