unit untMyToolTipPanel1408;

interface

 uses
   System.Types,
   System.Classes,
   System.UITypes,
   FMX.Objects,
   FMX.StdCtrls,
   FMX.Types,
   FMX.Controls,
   FMX.Forms,
   FMX.Edit;

 type
   TToolTipPanel = class(TPanel)
   private
//     FOnlyInputFields: Boolean;
     FDataName: array of string;
     FDataTip:  array of string;

     FMousePoint: TPointF;
     FCounter: Cardinal;
     FActiveControl: TFmxObject;
     FLabel: TLabel;
     FRectangle: TRectangle;
     FTimer: TTimer;
     FBorderWidth: Single;
     FFontColor: TAlphaColor;
    FColor: TAlphaColor;
    FStrokeColor: TAlphaColor;
     function GetToolTipText: string;
     procedure SetToolTipText(const Value: string);
     procedure OnTimer(Sender: TObject);

     function TipWhereNameIs(aName: string): string;

   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure ShowToolTip(AX, AY: Single);

     procedure ClearData();
     procedure AppendData(aName: String; aTip: String);

     property Text: string read GetToolTipText write SetToolTipText;
     property BorderWidth: Single read FBorderWidth write FBorderWidth;

     property FontColor: TAlphaColor   read FFontColor   write FFontColor;
     property Color: TAlphaColor       read FColor       write FColor;
     property StrokeColor: TAlphaColor read FStrokeColor write FStrokeColor;

     //     property OnlyInputFields: Boolean read FOnlyInputFields write FOnlyInputFields;
   end;

implementation

 function TToolTipPanel.GetToolTipText: string;
 begin
   Result := FLabel.Text;
 end;
 procedure TToolTipPanel.SetToolTipText(const Value: string);
 begin
   FLabel.Text := Value ;
 end;

procedure TToolTipPanel.AppendData(aName, aTip: String);
var
  tmpNewLength: Integer;
begin
  tmpNewLength := Length(FDataName) + 1;

  SetLength(FDataName, tmpNewLength);
  SetLength(FDataTip,  tmpNewLength);

  FDataName[tmpNewLength-1] := aName;
  FDataTip [tmpNewLength-1] := aTip;
end;

procedure TToolTipPanel.ClearData;
begin
  SetLength(FDataName, 0);
  SetLength(FDataTip,  0);
end;

function TToolTipPanel.TipWhereNameIs(aName: string): string;
var
  i: Integer;
  tmpResult: String;
begin
  tmpResult := '';
  for i := 0 to Length(FDataName) - 1 do
    if aName = FDataName[i] then
      tmpResult := FDataTip[i];

  Result := tmpResult;
end;

constructor TToolTipPanel.Create(AOwner: TComponent);
 begin
   inherited; //inherits the behavior from TPanel

   Visible := False;

   FRectangle := TRectangle.Create(AOwner);
   FRectangle.Parent := Self;
   FRectangle.Align := TAlignLayout.alClient;

   FLabel := TLabel.Create(AOwner);
   FLabel.Parent := FRectangle;
   FLabel.StyledSettings := [];
   FLabel.FontColor := $FF000000;
   if assigned(FLabel.Canvas) then
     Height := FLabel.Canvas.TextHeight(FLabel.Text);
   FLabel.Align := TAlignLayout.alClient;
   FLabel.TextAlign := TTextAlign.taCenter;
   FLabel.VertTextAlign := TTextAlign.taCenter;

   FTimer := TTimer.Create(AOwner);
   FTimer.OnTimer := OnTimer;
   FTimer.Enabled := True;
   FTimer.Interval := 500;

   FActiveControl := nil;

   FCounter := 1000;

   FBorderWidth := 10;
 end;

 destructor TToolTipPanel.Destroy;
 begin
   inherited;
 end;

procedure TToolTipPanel.ShowToolTip(AX, AY: Single);
var
  tmpAdjustedPosition: TPointF;
const
  TMP_MARGIN = 3;
begin
  FLabel.FontColor        := FFontColor;
  FRectangle.Fill.Color   := FColor;
  FRectangle.Stroke.Color := FStrokeColor;

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

  if Round(FMousePoint.X) < (Parent as TForm).Width / 2 then
    tmpAdjustedPosition.X := AX + TMP_MARGIN
  else
    tmpAdjustedPosition.X := AX - Width - TMP_MARGIN;

  if Round(FMousePoint.Y) < (Parent as TForm).Height / 2 then
    tmpAdjustedPosition.Y := AY + TMP_MARGIN
  else
    tmpAdjustedPosition.Y := AY - Height - TMP_MARGIN;

   self.Position.Point := tmpAdjustedPosition;

   self.Visible := True;
 end;

procedure TToolTipPanel.OnTimer;
var
  LActiveControl : IControl;
  LControl : TControl;
  LMousePos : TPointF;
  LObject : IControl ;
  tmpObjectName: String;
begin

  // 動いていれば
  if Screen.MousePos <> FMousePoint then
  begin
    FMousePoint := Screen.MousePos ;
    FCounter := 0;
    Visible := False;
  end ;

  Inc(FCounter);

  case FCounter of
    0..1: Visible := False ;
    2:
    begin
      tmpObjectName := '';
      if Parent is TForm then
      begin
        //identifies the object on which the mouse cursor is located
        LObject := (Parent as TForm).ObjectAtPoint(FMousePoint) ;
        if Assigned(LObject) then
          tmpObjectName := LObject.GetObject.Name;
      end;

      Text := TipWhereNameIs(tmpObjectName);

      LMousePos := (Parent as TForm).ScreenToClient(FMousePoint);

      if Text <> '' then
        ShowToolTip(LMousePos.X, LMousePos.Y);
    end;
    // the tooltip is displayed for a limited time. In this case it is displayed until FCounter reaches 10
    3..15:;
    else
    begin
      FCounter := 1000;
      Visible := False ;
    end;
  end;

 end;

end.