Question

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

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

仅供参考，我们可以模拟当您进入输入密码的TEdit控件时会发生什么，并且如果打开大写锁定则会出现警告。遗憾的是，我们无法使用xpmanifest自动执行此操作。

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

感谢您一如既往的帮助。

Answer 1

巧合的是我只是想做一些非常相似的事情并且最终创建了我自己的类派生自 ~~TShape~~ ~~TGraphicControl~~ TCustomPanel（使用TCustomPanel，因为TGraphicControl永远不会拥有它z-order高于任何其他窗口控件），但使用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隐藏它。

我添加了一个显示的属性，用于指示工具提示已在某个点显示，然后添加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;

没有XP清单的Delphi 7控件上的气球提示

1 个答案: