Всплывающие подсказки по элементам управления в Delphi 7 без манифеста XP - PullRequest
Новая
       6

Всплывающие подсказки по элементам управления в Delphi 7 без манифеста XP

1 голос
/ 12 октября 2011

Мы используем здесь код http://www.delphitricks.com/source-code/forms/show_balloon_tooltips_in_my_delphi_program.html для вызова всплывающей подсказки на элементе управления TEdit.

Проблема в том, что подсказка появляется только в том случае, если указатель мыши находится над элементом управления, следовательно, кодна OnEnter или OnChange, которые должны показать, что подсказка не срабатывает.Мы предполагаем, что код, который мы используем, похож на стандартные подсказки, которые появляются только тогда, когда мышь находится над элементом управления, но нам нужно, чтобы он появлялся там, где в данный момент находится мышь.

К вашему сведению, так мы можем эмулироватьчто происходит, когда вы входите в элемент управления TEdit, где вводится пароль, и появляется предупреждение, если включена блокировка заглавных букв.К сожалению, мы не можем использовать xpmanifest, чтобы сделать это автоматически.

Как мы можем получить подсказку, которая будет отображаться, если мышь не находится над ней?

Спасибо за вашу помощь, как всегда.

1 Ответ

0 голосов
/ 04 ноября 2011

По совпадению я просто хотел сделать что-то очень похожее и закончил тем, что создал свой собственный класс, полученный из TShape TGraphicControl TCustomPanel (используя TCustomPanel, поскольку TGraphicControl никогда не может иметь его z-Порядок выше любого другого оконного элемента управления), но с использованием некоторого кода Paint из TShape, переопределяя метод 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 в ложь) вызовсобытие 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;
...