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.