德爾福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;