Display Similar to this

WEB TMS WEB Core
1

How can I display something like this when moving the mouse over an element and then clicking on it?
2022-05-19_18-46-07

2

Using Bootstrap I hope? I tried this out and it seems to work, though you'd have to generalize it for more than one button.

unit Unit1;

interface

uses
  System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
  WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls;

type
  TForm1 = class(TWebForm)
    WebButton1: TWebButton;
    procedure WebFormCreate(Sender: TObject);
    procedure SetBootstrapTooltip(btn: TWebButton);
    procedure WebButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  btnTooltip: JSValue;

implementation

{$R *.dfm}

procedure TForm1.SetBootstrapTooltip(btn: TWebButton);
var
  ElemID: String;
  ToolText: String;
begin
  ElemID := btn.ElementID;
  ToolText := btn.Hint;
  asm
    var btn = document.getElementById(ElemID)
    this.btntooltip = new bootstrap.Tooltip(btn, {
      title: ToolText,
      placement: 'right',
      customClass: 'MyCustomToolTipClass',
      delay: { "show": 100, "hide": 250 }
    });
  end;
end;

procedure TForm1.WebButton1Click(Sender: TObject);
begin
  asm
    if (!(this.btnTooltip === null)) {
      if (!(document.getElementById(this.btntooltip.tip.id) === null)) {
        document.getElementById(this.btntooltip.tip.id).lastElementChild.innerText = 'After Click';
    }}
  end;
end;

procedure TForm1.WebFormCreate(Sender: TObject);
begin
  SetBootstrapTooltip(WebButton1)
end;

I know that TMS added direct support for Bootstrap hints not that long ago, but I still kinda prefer the approach of creating them this way so I can put them where I want them to be.

hints

It also conveniently gets reset to the original version after because the tooltip is regenerated each time it is needed.

3

Here's a slight alteration that might work better with multiple buttons. The tooltip class is used to find it (if it exists at that time) rather than keeping track of the tooltip object itself.

unit Unit1;

interface

uses
  System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
  WEBLib.Forms, WEBLib.Dialogs, Vcl.Controls, Vcl.StdCtrls, WEBLib.StdCtrls;

type
  TForm1 = class(TWebForm)
    WebButton1: TWebButton;
    WebButton2: TWebButton;
    WebButton3: TWebButton;
    procedure WebFormCreate(Sender: TObject);
    procedure SetBootstrapTooltip(btn: TWebButton);
    procedure WebButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SetBootstrapTooltip(btn: TWebButton);
var
  ElemID: String;
  ToolText: String;
  TipClass: String;
begin
  ElemID := btn.ElementID;
  ToolText := btn.Hint;
  TipClass := btn.ElementID+'-tip';
  asm
    var btn = document.getElementById(ElemID)
    var tip = new bootstrap.Tooltip(btn, {
      title: ToolText,
      placement: 'right',
      customClass: TipClass,
      delay: { "show": 100, "hide": 250 }
    });
  end;
end;

procedure TForm1.WebButton1Click(Sender: TObject);
var
 tip: String;
begin
  if (Sender is TWebButton) then
  begin
    tip := (Sender as TWebButton).ElementID+'-tip';
    asm
      var tips = document.getElementsByClassName(tip);
      for (var i = 0; i < tips.length; i++) {
        tips[i].lastElementChild.innerText = 'After Click';
      }
    end;
  end;
end;

procedure TForm1.WebFormCreate(Sender: TObject);
begin
  SetBootstrapTooltip(WebButton1);
  SetBootstrapTooltip(WebButton2);
  SetBootstrapTooltip(WebButton3);
end;

end.

hints2

4

Thanks very much Andrew. That is just what I wanted!

1 Like
5

Happy to help! I love having little challenges to solve. Helps me fill the time when I'm procrastinating about the bigger challenges I have to solve :laughing:

1 Like