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 プロパティはコードから変更できない?