System.UITypes,
FMX.Dialogs,
MessageDlg('Err: GetSpecialFolder', TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
System.UITypes,
FMX.Dialogs,
MessageDlg('Err: GetSpecialFolder', TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
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.
unit untFormHelp;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
FMX.StdCtrls, FMX.TabControl, FMX.Objects, FMX.Layouts;
type
TfrmHelp = class(TForm)
tbcHelp: TTabControl;
TabItem1: TTabItem;
TabItem2: TTabItem;
TabItem3: TTabItem;
TabItem4: TTabItem;
Image1: TImage;
Label1: TLabel;
Image2: TImage;
VertScrollBox1: TVertScrollBox;
VertScrollBox2: TVertScrollBox;
Image3: TImage;
VertScrollBox3: TVertScrollBox;
Image4: TImage;
Layout1: TLayout;
Button0: TButton;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Layout2: TLayout;
btnClose: TButton;
Layout3: TLayout;
Layout4: TLayout;
Layout5: TLayout;
Layout6: TLayout;
TabItem5: TTabItem;
procedure FormCreate(Sender: TObject);
procedure Button0Click(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
const
PAGE_COUNT = 5;
private
FButton: array[0..PAGE_COUNT-1] of TButton;
procedure setPageIndex(const Value: Integer);
public
property PageIndex: Integer write setPageIndex;
end;
var
frmHelp: TfrmHelp;
implementation
uses
untMainForm;
{$R *.fmx}
procedure TfrmHelp.btnCloseClick(Sender: TObject);
begin
self.Close;
end;
procedure TfrmHelp.Button0Click(Sender: TObject);
begin
PageIndex := TButton(Sender).Tag;
end;
procedure TfrmHelp.FormCreate(Sender: TObject);
begin
FButton[0] := Button0;
FButton[1] := Button1;
FButton[2] := Button2;
FButton[3] := Button3;
FButton[4] := Button4;
tbcHelp.TabPosition := TTabPosition.tpNone;
PageIndex := 0;
end;
procedure TfrmHelp.setPageIndex(const Value: Integer);
var
i: Integer;
begin
for i := 0 to PAGE_COUNT - 1 do
if i <> Value then
FButton[i].IsPressed := False
else
FButton[i].IsPressed := True;
tbcHelp.TabIndex := Value;
end;
end.
アニメーションの property プロパティはコードから変更できない?