Firemonkey - Tooltip-Componente

[AnCorr]

Hallo zusammen,

es kommt ja nicht oft vor, dass ich der Meinung bin, etwas veroeffentlichen zu koennen.

Wem die Vorgeschichte nicht interessiert, kann gleich zum Hauptthema springen.

Vorgeschichte:
Ich wollte mir mal wieder ein kleines Programm schreiben (wie so oft). Das Programm sollte fuer mich ein paar kleine 'Gimmicks' haben. Nach langem Suchen und Herumprobieren, war ich mit meinem Ergebnis, was ich mit meinem Kenntnisstand und gefundenen Moeglichkeiten erreichen konnte, nicht sehr zufrieden.
Ich habe dann mal einen Blick auf die Firemonkey Demos geworfen, und bin dort fuendig geworden. Ich habe somit vor kurzem angefangen mein Programm mit Firemonkey zu erstellen.
Dabei musste ich dann feststellen, dass Firemonkey nicht immer "Vorteile" hat. So auch beim Thema Tooltips.

Hauptthema:
Tooltips mit Firemonkey.
Mit dem Beispiel von Embarcadero war ich nicht sonderlich zufrieden, aber es hat mir gut als Grundlage dienen koennen.
Auf Basis des Beispieles habe ich nun eine "eigene" Komponente erstellt, mit der man Tioltips anzeigen lassen kann.

Die Komponente besteht aus:
Form: durchsichtig
Rectangle: hiermit kann das Aussehen gesteuert werden
Label: enthaelt den eigentlichen anzuzeigenden Text
Timer Delay: stellt die Verzoegerungszeit ein, nach der ein Tooltip angezeigt werden soll
Timer Interval: stellt die Zeit ein, wie lange ein Tooltip angezeigt werden soll
StringList Controls: enthaelt die Namen der Controls, fuer welche ein Tooltip angezeigt werden soll
StringList Tipps: enthaelt die zugehoerigen anzuzeigenden Texte.

Delphi-Quellcode:

unit FrmToolTip;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Objects;

type
  TTooltip = class(TForm)
    FShape: TRectangle;
    FDelay: TTimer;
    FInterval: TTimer;

  private
    Elements: TStringList;
    Tips: TStringList;
    FLabel: TLabel;
    FMousePoint: TPointF ;
    FCounter: Cardinal;
    FActiveControl: TFmxObject ;
    FBorderWidth: Single;
    function GetElementIndex(EName: String): Integer;
    function GetElementTip(EName: String): String;
    function GetToolTipText: String;
    procedure SetToolTipText(const Value: String);
    procedure ShowDelayOnTimer(Sender: TObject);
    procedure ShowTimeOnTimer(Sender: TObject);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowToolTip(AX, AY: Single);
    procedure AddControlName(const Value: String);
    procedure AddControlTip(const Value: String);
    property Text : String read GetToolTipText write SetToolTipText;
    property BorderWidth : Single read FBorderWidth write FBorderWidth;

  end;

implementation

{$R *.fmx}

{$region 'Create/Destroy'}

constructor TTooltip.Create(AOwner: TComponent);
begin
  inherited;

  //Elements which will show a tooltip
  Elements := TStringList.Create;

  //Tips to display
  Tips := TStringList.Create;

  Show;
  Hide;

  FLabel := TLabel.Create(AOwner);
  FLabel.Parent := Self;
  FLabel.StyleLookup := 'labelstyle';
  FLabel.Text := 'FMXToolTip';

  if assigned(FLabel.Canvas) then
    Height := Round(FLabel.Canvas.TextHeight(FLabel.Text));

  FLabel.Align := TAlignLayout.alClient;
  FLabel.TextAlign := TTextAlign.taCenter;
  FLabel.VertTextAlign := TTextAlign.taCenter;

  FDelay := TTimer.Create(AOwner);
  FDelay.OnTimer := ShowDelayOnTimer;
  FDelay.Enabled := True ;
  FDelay.Interval := 200;

  FInterval := TTimer.Create(AOwner);
  FInterval.OnTimer := ShowTimeOnTimer;
  FInterval.Enabled := false;
  FInterval.Interval := 1200;

  FActiveControl := nil;
  FCounter := 1000;
  FBorderWidth := 5;

end;

destructor TTooltip.Destroy;
begin
  inherited;

end;

{$endregion 'Create/Destroy'}

{$region 'Fill lists'}

procedure TTooltip.AddControlName(const Value: String);
begin
  Elements.Add(Value);

end;

procedure TTooltip.AddControlTip(const Value: String);
begin
  Tips.Add(Value);

end;

{$endregion 'Fill lists'}

{$region 'Get/Set tooltip text'}

function TTooltip.GetElementIndex(EName: String): Integer;
var
  i: Integer;

begin
  i := -1;

  for i := 0 to Elements.Count - 1 do
  begin
    if Elements[i] = EName then
    begin
      Result := i;
      break;

    end;

  end;

end;

function TTooltip.GetElementTip(EName: String): String;
var
  i: Integer;

begin
  for i := 0 to Elements.Count - 1 do
  begin
    if Elements[i] = EName then
    begin
      Result := Tips[i];
      break;

    end;

  end;

end;

function TTooltip.GetToolTipText: String;
begin
  Result := FLabel.Text;

end;

procedure TTooltip.SetToolTipText(const Value: String);
begin
  FLabel.Text := Value ;

end;

{$endregion 'Get/Set tooltip text'}

{$region 'Show tooltip'}

procedure TTooltip.ShowToolTip(AX, AY: Single);
var
  PointX: Single;
  PointY: Single;

begin
  PointX := AX + 5; //+ 5 to leave some space for a more decent look
  PointY := AY + 5; // dito

  try
    Height := Round(FLabel.Canvas.TextHeight(FLabel.Text) + 2 * FBorderWidth);
    Width  := Round(FLabel.Canvas.TextWidth(FLabel.Text) + 2 * FBorderWidth) + 8;

    if (PointX + Width) > Screen.Size.Width then
      PointX := PointX - Width - 5; //s. a.

    if (PointY + Height) > Screen.Size.Height then
      PointY := PointY - Height - 5; //s. a.

    Left := Round(PointX);
    Top := Round(PointY);

    FDelay.Enabled := false;
    FInterval.Enabled := true;

    Show;

  except
    on E:Exception do
      ShowMessage(E.Message);

  end;

end;

{$endregion 'Show tooltip'}

{$region 'Timer action'}

procedure TTooltip.ShowDelayOnTimer;
var
  LActiveControl : IControl;
  LControl : TControl;
  LMousePos : TPointF;
  LObject : IControl ;
  i: Integer;

begin
  try

    if Screen.MousePos <> FMousePoint then
    begin
      FMousePoint := Screen.MousePos ;
      FCounter := 0;
      Hide;

    end ;

    Inc(FCounter);

    case FCounter of
      0..2:
        Hide;
      3:
      begin
        Text := '';

        if Parent is TForm then
        begin
          LObject := (Parent as TForm).ObjectAtPoint(FMousePoint) ;

          if Assigned(LObject) then
          begin
            Text := LObject.GetObject.Name;

            if GetElementIndex(Text) <> -1 then
            begin
              Text := GetElementTip(Text);
                LMousePos := Screen.MousePos;
                ShowToolTip(LMousePos.X, LMousePos.Y);

            end;

          end;

        end;

      end;

    else
      FCounter := 1000;
      Hide;

    end;

  except
    on E:Exception do
      ShowMessage('Error: ' + E.Message);

  end;

end;

procedure TTooltip.ShowTimeOnTimer(Sender: TObject);
begin
  FInterval.Enabled := false;
  FDelay.Enabled := true;
  //Hide tooltip
  Hide;

end;

{$endregion 'Timer action'}

end.

Genutzt wird die Komponente zum Beispiel so:

Delphi-Quellcode:

uses
  ....., FrmTooltip;

var
  ...
  Tooltip : TToolTip;


procedure Form1.Show;
begin
  //Erstellen der Tooltip-Komponente
  Tooltip := TToolTip.Create(Tooltip);

  //Zuweisen der "Elternform"
  Tooltip.Parent := Mainform ;

  //Hinzufuegen von Elementen, fuer die ein Tipp angezeigt werden soll
  Tooltip.AddControlName('Image_Beispiel');
  Tooltip.AddControlName('Edit_Beispiel');
  Tooltip.AddControlName('Listbox_Beispiel');

  //Hinzufuegen der Texte, welche angezeigt werden sollen
  Tooltip.AddControlTip('Dies ist der Tip zum Bild Image_Beispiel');
  Tooltip.AddControlTip('Dies ist der Tip zur TextBox Edit_Beispiel');
  Tooltip.AddControlTip('Dies ist der Tip zur ListBox Listbox_Beispiel');

  //Konfiguration der Timer und des Erscheinungsbildes
  Tooltip.FDelay := 250; //Default = 200
  Tooltip.FInterval := 1000;  //Default = 1200
  Tooltip.FShape.XRadius := 8;  //Default = 4
  Tooltip.FShape.YRadius := 8;  //Default = 4
  Tooltip.FShape.Fill.Kind := TBrushKind.bkSolid; //Default = bkGradient
  Tooltip.FShape.Fill.Color := $FFE0E0E0;

end;

Ich hoffe, ich habe soweit alles richtig angegeben, und auch hoffentlich die richtige Forumsrubrik gewaehlt.
Vielleicht kann der eine oder andere ja die Komponente gebrauchen.


Ich moechte mir hier auch noch einmal bei Embarcadero fuer das Beispiel bedanken.



Gruss
AnCorr