API tools faq
paste
Advertisement
Goaul

Untitled

Goaul
Dec 13th, 2013
375
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 50.11 KB | None | 0 0
raw download clone embed print report
  1. unit Fmx.HintManager;
  2.  
  3. interface
  4.  
  5.   (************************************************** )
  6.   (                                                   )
  7.   (  Copyright (c) 1997-2012 FNS Enterprize's™        )
  8.   (                2003-2012 himitsu @ Delphi-PRAXiS  )
  9.   (                                                   )
  10.   (  Description   -                                  )
  11.   (  Filename      Fmx.HintManager.pas                )
  12.   (  Version       v1.3                               )
  13.   (  Date          24.10.2012                         )
  14.   (  InitialDate   04.08.2012                         )
  15.   (  System        Fmx                                )
  16.   (  Personality   Delphi XE2, XE3                    )
  17.   (  Project       FmxHintManager                     )
  18.   (  Support       www.delphipraxis.net/169747-b.html )
  19.   (                                                   )
  20.   (  License       MPL v1.1 , GPL v3.0 or LGPL v3.0   )
  21.   (                                                   )
  22.   (  Donation      http://geheimniswelten.de/spenden  )
  23.   (                                                   )
  24.   (***************************************************)
  25.  
  26.   {$REGION 'license'}
  27.   //
  28.   // Mozilla Public License (MPL) v1.1
  29.   // GNU General Public License (GPL) v3.0
  30.   // GNU Lesser General Public License (LGPL) v3.0
  31.   //
  32.   //
  33.   //
  34.   // The contents of this file are subject to the Mozilla Public License
  35.   // Version 1.1 (the "License"); you may not use this file except in
  36.   // compliance with the License.
  37.   // You may obtain a copy of the License at http://www.mozilla.org/MPL .
  38.   //
  39.   // Software distributed under the License is distributed on an "AS IS"
  40.   // basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
  41.   // License for the specific language governing rights and limitations
  42.   // under the License.
  43.   //
  44.   // The Original Code is "FmxHintManager".
  45.   //
  46.   // The Initial Developer of the Original Code is "himitsu".
  47.   // Portions created by Initial Developer are Copyright (C) 2009.
  48.   // All Rights Reserved.
  49.   //
  50.   // Contributor(s): -
  51.   //
  52.   // Alternatively, the contents of this file may be used under the terms
  53.   // of the GNU General Public License Version 3.0 or later (the "GPL"), or the
  54.   // GNU Lesser General Public License Version 3.0 or later (the "LGPL"),
  55.   // in which case the provisions of GPL or the LGPL are applicable instead of
  56.   // those above. If you wish to allow use of your version of this file only
  57.   // under the terms of the GPL or the LGPL and not to allow others to use
  58.   // your version of this file under the MPL, indicate your decision by
  59.   // deleting the provisions above and replace them with the notice and
  60.   // other provisions required by the GPL or the LGPL. If you do not delete
  61.   // the provisions above, a recipient may use your version of this file
  62.   // under either the MPL, the GPL or the LGPL.
  63.   //
  64.   //
  65.   //
  66.   // HTML:                               PlainText:
  67.   // www.mozilla.org/MPL/MPL-1.1.html    www.mozilla.org/MPL/MPL-1.1.txt
  68.   // www.gnu.org/licenses/gpl-3.0.html   www.gnu.org/licenses/gpl-3.0.txt
  69.   // www.gnu.org/licenses/lgpl-3.0.html  www.gnu.org/licenses/lgpl-3.0.txt
  70.   //
  71.   {$ENDREGION}
  72.  
  73. uses
  74.   System.Types, System.SysUtils, System.Classes, System.UITypes, System.Math,
  75.   FMX.Types, FMX.Forms, FMX.Dialogs, FMX.Objects, FMX.Controls, FMX.Effects,
  76.   FMX.Edit, FMX.StdCtrls, FMX.Graphics;
  77.  
  78. type
  79.   THintItem  = class;
  80.   THintPos   = (hpBottom, hpRight, hpTop, hpLeft, hpDefault);
  81.   THintImage = (hiNone, hiImage1, hiImage2, hiImage3, hiDefault);
  82.   THintEvent = function(Sender: TObject; Form: TCustomForm; Position: TRectF; Text: string; Image: THintImage; AssignedComp: TControl = nil): Boolean of object;
  83.  
  84.   THintManager = class(TFmxObject)
  85.   strict private type
  86.     THintData = record
  87.       Mode:  (hmNone, hmPoint, hmRect, hmComp);
  88.       Point: TPointF;
  89.       Rect:  TRectF;
  90.       Comp:  TControl;
  91.       Hint:  string;
  92.       Image: THintImage;
  93.     end;
  94.     THintShow = (hsImmediately, hsShort, hsNormal, hsRefresh);
  95.   strict private
  96.     FNil:            TControl;
  97.     FHintForm:       TCalloutRectangle;
  98.     FHintImage1:     TImage;
  99.     FHintImage2:     TImage;
  100.     FHintImage3:     TImage;
  101.     FHintLabel:      TLabel;
  102.     FHintGlow:       TGlowEffect;
  103.     FHintShadow:     TShadowEffect;
  104.     FHintShowTimer:  TTimer;
  105.     FHintHideTimer:  TTimer;
  106.     FHintPause:      Integer;
  107.     FHintHidePause:  Integer;
  108.     FHintShortPause: Integer;
  109.   //FHintShortCuts:  Boolean;
  110.     FHintPos:        THintPos;
  111.     FHintImage:      THintImage;
  112.     FOnShowHint:     THintEvent;
  113.     FOnHideHint:     TNotifyEvent;
  114.     FFire:           Boolean;
  115.     FFireTimer:      TTimer;
  116.     FMaxWidth:       Single;
  117.     FNextHint:       THintData;
  118.     FCurrentHint:    THintData;
  119.     {$IF RTLVersion >= 24}
  120.     FMeasureBitmap:  TBitmap;
  121.     {$IFEND}
  122.     procedure AddNewHint                (Value: TControl);
  123.     function  GetAlignLayout:                   TAlignLayout;
  124.     procedure SetAlignLayout            (Value: TAlignLayout);
  125.     function  GetBrBitmap:                      TBrushBitmap;
  126.     procedure AssignBrBitmap            (Value: TBrushBitmap);
  127.     procedure SetHintPos                (Value: THintPos);
  128.     function  GetFontName:                      TFontName;
  129.     procedure SetFontName               (Value: TFontName);
  130.     function  GetFontStyle:                     TFontStyles;
  131.     procedure SetFontStyle              (Value: TFontStyles);
  132.     procedure SetHintImage              (Value: THintImage);
  133.     function  GetBitmap     (I: Integer):       TBitmap;
  134.     procedure AssignBitmap  (I: Integer; Value: TBitmap);
  135.     function  GetBoolean    (I: Integer):       Boolean;
  136.     procedure SetBoolean    (I: Integer; Value: Boolean);
  137.     function  GetColor      (I: Integer):       TAlphaColor;
  138.     procedure SetColor      (I: Integer; Value: TAlphaColor);
  139.     function  GetGradient   (I: Integer):       TGradient;
  140.     procedure AssignGradient(I: Integer; Value: TGradient);
  141.     function  GetKind       (I: Integer):       TBrushKind;
  142.     procedure SetKind       (I: Integer; Value: TBrushKind);
  143.     function  GetSingle     (I: Integer):       Single;
  144.     procedure SetSingle     (I: Integer; Value: Single);
  145.     function  GetString     (I: Integer):       String;
  146.     procedure SetString     (I: Integer; Value: String);
  147.     function  GetWrapMode   (I: Integer):       TImageWrapMode;
  148.     procedure SetWrapMode   (I: Integer; Value: TImageWrapMode);
  149.     procedure DoShowTimer   (Sender: TObject);
  150.     procedure DoHideTimer   (Sender: TObject);
  151.     procedure DoFireTimer   (Sender: TObject);
  152.   protected
  153.     class procedure ChangeRefVar(var Ref; NewValue, Comp: TComponent);
  154.     class var BeforeNewHint: procedure(Comp: TControl; var Form: TComponent);
  155.     class var AfterNewHint:  procedure(Hint: THintItem);
  156.     function  LoadText     (Comp: TComponent; AutoTranslate: Boolean): string;
  157.     procedure CreateHint;
  158.     procedure InnerShowHint(Mode: THintShow);
  159.     procedure InnerHideHint(CurrentHint, NextHint: Boolean);
  160.     procedure Notification (Component: TComponent; Operation: TOperation); override;
  161.     procedure HintShow     (Item:  THintItem; Immediately: Boolean = False);
  162.     procedure HintRefresh  (Item:  THintItem);
  163.     procedure HintHide     (Item:  THintItem; Immediately: Boolean = False);
  164.     procedure Repaint;
  165.   public
  166.     constructor Create(Owner: TComponent); override;
  167.     destructor  Destroy; override;
  168.     procedure ShowHint(const AbsolutePos: TPointF;  Hint: string;      Image: THintImage = hiDefault; Translate: Boolean = False); overload;
  169.     procedure ShowHint(const AbsolutePos: TRectF;   Hint: string;      Image: THintImage = hiDefault; Translate: Boolean = False); overload;
  170.     procedure ShowHint(      Component:   TControl; Hint: string = ''; Image: THintImage = hiDefault; Translate: Boolean = False); overload;
  171.     procedure HideHint;
  172.     function  IsHintVisible: Boolean;
  173.   published
  174.     property AddHintToComponent: TControl                read FNil            write AddNewHint      stored  False;
  175.  
  176.     property HintPause:          Integer                 read FHintPause      write FHintPause      default 500;
  177.     property HintHidePause:      Integer                 read FHintHidePause  write FHintHidePause  default 2500;
  178.     property HintShortPause:     Integer                 read FHintShortPause write FHintShortPause default 50;
  179.   //property HintShortCuts:      Boolean                 read FHintShortCuts  write FHintShortCuts  default False;
  180.   //property HintColor:          TAlphaColor             read GetHintColor    write SetHintColor    stored  False;
  181.  
  182.     property CalloutPosition:    THintPos                read FHintPos        write SetHintPos      default hpTop;
  183.     property CalloutLength:      Single         index 10 read GetSingle       write SetSingle       ;//default 10;
  184.     property CalloutOffset:      Single         index 11 read GetSingle       write SetSingle       ;//default 15;
  185.     property CalloutWidth:       Single         index 12 read GetSingle       write SetSingle       ;//default 20;
  186.  
  187.     property FillKind:           TBrushKind     index 20 read GetKind         write SetKind         default TBrushKind.bkSolid;
  188.     property FillColor:          TAlphaColor    index 21 read GetColor        write SetColor        default TAlphaColorRec.Beige;
  189.     property FillGradient:       TGradient      index 22 read GetGradient     write AssignGradient;
  190.     property FillBitmap:         TBrushBitmap            read GetBrBitmap     write AssignBrBitmap;
  191.  
  192.     property StrokeKind:         TBrushKind     index 30 read GetKind         write SetKind         default TBrushKind.bkSolid;
  193.     property StrokeColor:        TAlphaColor    index 31 read GetColor        write SetColor        default TAlphaColorRec.Black;
  194.     property StrokeGradient:     TGradient      index 32 read GetGradient     write AssignGradient;
  195.     property StrokeThickness:    Single         index 33 read GetSingle       write SetSingle       ;//default ;
  196.  
  197.     property Image:              THintImage              read FHintImage      write SetHintImage    default hiNone;
  198.  
  199.     property Image1Bitmap:       TBitmap        index 40 read GetBitmap       write AssignBitmap;
  200.     property Image1Width:        Single         index 41 read GetSingle       write SetSingle       ;//default ;
  201.     property Image1Height:       Single         index 42 read GetSingle       write SetSingle       ;//default ;
  202.     property Image1WrapMode:     TImageWrapMode index 43 read GetWrapMode     write SetWrapMode     default TImageWrapMode.iwFit;
  203.  
  204.     property Image2Bitmap:       TBitmap        index 45 read GetBitmap       write AssignBitmap;
  205.     property Image2Width:        Single         index 46 read GetSingle       write SetSingle       ;//default ;
  206.     property Image2Height:       Single         index 47 read GetSingle       write SetSingle       ;//default ;
  207.     property Image2WrapMode:     TImageWrapMode index 48 read GetWrapMode     write SetWrapMode     default TImageWrapMode.iwFit;
  208.  
  209.     property Image3Bitmap:       TBitmap        index 50 read GetBitmap       write AssignBitmap;
  210.     property Image3Width:        Single         index 51 read GetSingle       write SetSingle       ;//default ;
  211.     property Image3Height:       Single         index 52 read GetSingle       write SetSingle       ;//default ;
  212.     property Image3WrapMode:     TImageWrapMode index 53 read GetWrapMode     write SetWrapMode     default TImageWrapMode.iwFit;
  213.  
  214.     property FontFamily:         TFontName               read GetFontName     write SetFontName     ;//default ;
  215.     property FontSize:           Single         index 61 read GetSingle       write SetSingle       ;//default ;
  216.     property FontStyle:          TFontStyles             read GetFontStyle    write SetFontStyle    default [];
  217.     property FontStyleLookup:    string         index 63 read GetString       write SetString       ;//default ;
  218.     property FontStyleName:      string         index 64 read GetString       write SetString       ;//default ;
  219.     property FontAlign:          TAlignLayout            read GetAlignLayout  write SetAlignLayout  default TAlignLayout.alNone;
  220.     property FontWordWrap:       Boolean        index 66 read GetBoolean      write SetBoolean      default False;
  221.     property FontMaxWidth:       Single         index 67 read FMaxWidth       write SetSingle       ;//default ;
  222.  
  223.     property GlowEnabled:        Boolean        index 70 read GetBoolean      write SetBoolean      default False;
  224.     property GlowColor:          TAlphaColor    index 71 read GetColor        write SetColor        default TAlphaColorRec.Gold;
  225.     property GlowOpacity:        Single         index 72 read GetSingle       write SetSingle       ;//default ;
  226.     property GlowSoftness:       Single         index 73 read GetSingle       write SetSingle       ;//default ;
  227.     property GlowStyleName:      string         index 74 read GetString       write SetString       ;//default ;
  228.  
  229.     property ShadowEnabled:      Boolean        index 80 read GetBoolean      write SetBoolean      default True;
  230.     property ShadowColor:        TAlphaColor    index 81 read GetColor        write SetColor        default TAlphaColorRec.Black;
  231.     property ShadowDirection:    Single         index 82 read GetSingle       write SetSingle       ;//default ;
  232.     property ShadowDistance:     Single         index 83 read GetSingle       write SetSingle       ;//default ;
  233.     property ShadowOpacity:      Single         index 84 read GetSingle       write SetSingle       ;//default ;
  234.     property ShadowSoftness:     Single         index 85 read GetSingle       write SetSingle       ;//default ;
  235.     property ShadowStyleName:    string         index 86 read GetString       write SetString       ;//default ;
  236.  
  237.     property OnShowHint:         THintEvent              read FOnShowHint     write FOnShowHint;
  238.     property OnHideHint:         TNotifyEvent            read FOnHideHint     write FOnHideHint;
  239.  
  240.     property Fire:               Boolean        index 90 read GetBoolean      write SetBoolean      default False;
  241.   end;
  242.  
  243.   THintItem = class(TFmxObject, IControl)
  244.   strict private
  245.     FManager:       THintManager;
  246.     FHintText:      string;
  247.     FHintImage:     THintImage;
  248.     FHintVisible:   Boolean;
  249.     FTranslate:     Boolean;
  250.     procedure SetManager    (Value: THintManager);
  251.     function  GetControl:           TControl;
  252.     procedure SetControl    (Value: TControl);
  253.     function  GetCHitTest:          Boolean;
  254.     procedure SetCHitTest   (Value: Boolean);
  255.     procedure SetHintText   (Value: string);
  256.     procedure SetHintImage  (Value: THintImage);
  257.     procedure SetHintVisible(Value: Boolean);
  258.   private
  259.     {IControl}
  260.     function  GetObject: TFmxObject;
  261.     procedure SetFocus;
  262.     procedure DoEnter;
  263.     procedure DoExit;
  264.     procedure DoMouseEnter;
  265.     procedure DoMouseLeave;
  266.     function  ScreenToLocal(P: TPointF): TPointF;
  267.     function  LocalToScreen(P: TPointF): TPointF;
  268.     function  ObjectAtPoint(P: TPointF): IControl;
  269.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  270.     procedure MouseMove(Shift: TShiftState; X, Y: Single);
  271.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  272.     procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
  273.     procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  274.     procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  275.     procedure DialogKey(var Key: Word; Shift: TShiftState);
  276.     function  FindTarget(P: TPointF; const Data: TDragObject): IControl;
  277.     procedure DragEnter(const Data: TDragObject; const Point: TPointF);
  278.     procedure DragOver(const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
  279.     procedure DragDrop(const Data: TDragObject; const Point: TPointF);
  280.     procedure DragLeave;
  281.     procedure DragEnd;
  282.     function  CheckForAllowFocus: Boolean;
  283.     function  GetTabOrderValue: TTabOrder;
  284.     procedure UpdateTabOrder(Value: TTabOrder);
  285.     procedure Repaint;
  286.     function  GetDragMode: TDragMode;
  287.     procedure SetDragMode(const ADragMode: TDragMode);
  288.     procedure BeginAutoDrag;
  289.     function  GetParent: TFmxObject;
  290.     function  GetLocked: Boolean;
  291.     function  GetVisible: Boolean;
  292.     procedure SetVisible(const Value: Boolean);
  293.     function  GetHitTest: Boolean;
  294.     function  GetCursor: TCursor;
  295.     function  GetDesignInteractive: Boolean;
  296.     function  GetAcceptsControls: Boolean;
  297.     {$IF RTLVersion >= 24}
  298.     procedure BeginUpdate;
  299.     procedure EndUpdate;
  300.     procedure SetIsChildFocused(const Value: Boolean);
  301.     function  GetIsChildFocused: Boolean;
  302.     function  GetCanFocus: Boolean;
  303.     function  GetCanParentFocus: Boolean;
  304.     function  EnterChildren(AObject: TControl): Boolean;
  305.     function  ExitChildren(AObject: TControl): Boolean;
  306.     {$IFEND}
  307.   protected
  308.     procedure SetParent   (const Value: TFmxObject); override;
  309.     procedure Notification(Component: TComponent; Operation: TOperation); override;
  310.   public
  311.     constructor Create(Owner: TComponent); override;
  312.     procedure ApplyTriggerEffect(Instance: TFmxObject; const Trigger: string); override;
  313.   published
  314.     property Manager:        THintManager read FManager     write SetManager;
  315.     property Control:        TControl     read GetControl   write SetControl;
  316.     property ControlHitTest: Boolean      read GetCHitTest  write SetCHitTest    stored  False default False;
  317.     property HintText:       string       read FHintText    write SetHintText;
  318.     property HintImage:      THintImage   read FHintImage   write SetHintImage   default hiNone;
  319.     property HintVisible:    Boolean      read FHintVisible write SetHintVisible default True;
  320.     property AutoTranslate:  Boolean      read FTranslate   write FTranslate     default True;
  321.     property StyleName                                                           stored  False;
  322.     {$IF RTLVersion < 24}
  323.     property BindingName                                                         stored  False;
  324.     {$IFEND}
  325.   end;
  326.  
  327. implementation
  328.  
  329. { THintManager }
  330.  
  331. procedure THintManager.AddNewHint(Value: TControl);
  332. var
  333.   O: TComponent;
  334.   I: THintItem;
  335.   S: string;
  336. begin
  337.   if not Assigned(Value) then
  338.     Exit;
  339.   if Value.Owner is TForm then
  340.     O := Value.Owner
  341.   else
  342.     O := Value;
  343.   if Assigned(BeforeNewHint) then
  344.     BeforeNewHint(Value, O);
  345.   I := THintItem.Create(O);
  346.   I.Manager := Self;
  347.   I.Control := Value;
  348.   S := Format('%s_Hint', [Value.Name]);
  349.   if (Value.Name <> '') and not Assigned(I.Owner.FindComponent(S)) then
  350.     I.Name := S;
  351.   S := Format('%s_Hint_%p', [Value.Name, Pointer(I)]);
  352.   if (I.Name = '') and (Value.Name <> '') and not Assigned(I.Owner.FindComponent(S)) then
  353.     I.Name := S;
  354.   S := Format('Hint_%p', [Pointer(I)]);
  355.   if (I.Name = '') and (Value.Name <> '') and not Assigned(I.Owner.FindComponent(S)) then
  356.     I.Name := S;
  357.   if Assigned(AfterNewHint) then
  358.     AfterNewHint(I);
  359. end;
  360.  
  361. procedure THintManager.AssignBitmap(I: Integer; Value: TBitmap);
  362. begin
  363.   InnerHideHint(True, False);
  364.   case I of
  365.     40: FHintImage1.Bitmap.Assign(Value);
  366.     45: FHintImage2.Bitmap.Assign(Value);
  367.     50: FHintImage3.Bitmap.Assign(Value);
  368.   end;
  369. end;
  370.  
  371. procedure THintManager.AssignBrBitmap(Value: TBrushBitmap);
  372. begin
  373.   InnerHideHint(True, False);
  374.   FHintForm.Fill.Bitmap.Assign(Value);
  375. end;
  376.  
  377. procedure THintManager.AssignGradient(I: Integer; Value: TGradient);
  378. begin
  379.   InnerHideHint(True, False);
  380.   case I of
  381.     22: FHintForm.Fill.Gradient.Assign(Value);
  382.     32: FHintForm.Stroke.Gradient.Assign(Value);
  383.   end;
  384. end;
  385.  
  386. class procedure THintManager.ChangeRefVar(var Ref; NewValue, Comp: TComponent);
  387. var
  388.   Temp: TComponent;
  389.   RefC: TComponent absolute Ref;
  390. begin
  391.   if RefC = NewValue then
  392.     Exit;
  393.   Temp := RefC;
  394.   RefC := nil;
  395.   if Assigned(Temp) and not (csDestroying in Temp.ComponentState + Comp.ComponentState) then
  396.     Temp.RemoveFreeNotification(Comp);
  397.   RefC := NewValue;
  398.   if Assigned(NewValue) then
  399.     NewValue.FreeNotification(Comp);
  400. end;
  401.  
  402. constructor THintManager.Create(Owner: TComponent);
  403. var
  404.   C: TComponent;
  405. begin
  406.   inherited;
  407.  
  408.   FHintForm                 := TCalloutRectangle.Create(Self);
  409.   FHintForm.DesignVisible   := False;
  410.   FHintForm.Visible         := False;
  411.   FHintForm.CalloutLength   := 10;
  412.   FHintForm.CalloutOffset   := 15;
  413.   FHintForm.CalloutWidth    := 20;
  414.   FHintForm.Fill.Color      := TAlphaColorRec.Beige;
  415.   FHintForm.HitTest         := False;
  416.   FHintForm.Locked          := True;
  417.   FHintForm.StrokeCap       := TStrokeCap.scRound;
  418.  
  419.   FHintImage1             := TImage.Create(Self);
  420.   FHintImage1.Parent      := FHintForm;
  421.   FHintImage1.HitTest     := False;
  422.   FHintImage1.Locked      := True;
  423.  
  424.   FHintImage2             := TImage.Create(Self);
  425.   FHintImage2.Parent      := FHintForm;
  426.   FHintImage2.HitTest     := False;
  427.   FHintImage2.Locked      := True;
  428.  
  429.   FHintImage3             := TImage.Create(Self);
  430.   FHintImage3.Parent      := FHintForm;
  431.   FHintImage3.HitTest     := False;
  432.   FHintImage3.Locked      := True;
  433.  
  434.   FHintLabel              := TLabel.Create(Self);
  435.   FHintLabel.Parent       := FHintForm;
  436.   FHintLabel.AutoSize     := True;
  437.  
  438.   FHintGlow               := TGlowEffect.Create(Self);
  439.   FHintGlow.Parent        := FHintForm;
  440.   FHintGlow.Enabled       := False;
  441.  
  442.   FHintShadow             := TShadowEffect.Create(Self);
  443.   FHintShadow.Parent      := FHintForm;
  444.   FHintShadow.Enabled     := True;
  445.  
  446.   FHintShowTimer          := TTimer.Create(Self);
  447.   FHintShowTimer.Enabled  := False;
  448.   FHintShowTimer.OnTimer  := DoShowTimer;
  449.  
  450.   FHintHideTimer          := TTimer.Create(Self);
  451.   FHintHideTimer.Enabled  := False;
  452.   FHintHideTimer.OnTimer  := DoHideTimer;
  453.  
  454.   FHintPause              := 500;
  455.   FHintHidePause          := 2500;
  456.   FHintShortPause         := 50;
  457. //FHintShortCuts          := False;
  458.   FHintPos                := hpTop;
  459.   FNextHint.Mode          := hmNone;
  460.   FCurrentHint.Mode       := hmNone;
  461.  
  462.   FFireTimer              := TTimer.Create(Self);
  463.   FFireTimer.Enabled      := False;
  464.   FFireTimer.Interval     := 20;
  465.   FFireTimer.OnTimer      := DoFireTimer;
  466.  
  467.   if Assigned(Owner) then
  468.     for C in Owner do
  469.       if (C is THintItem) and not Assigned(THintItem(C).Manager) then
  470.         THintItem(C).Manager := Self;
  471. end;
  472.  
  473. procedure THintManager.CreateHint;
  474. var
  475.   HImage:     THintImage;
  476.   Image:      TImage;
  477.   Rect, Size: TRectF;
  478.   Pos:        THintPos;
  479.   Offset:     Single;
  480.   Form:       TCustomForm;
  481.   T:          TFmxObject;
  482.   C:          TCanvas;
  483. begin
  484.   if FCurrentHint.Hint = '' then begin
  485.     InnerHideHint(True, False);
  486.     Exit;
  487.   end;
  488.   HImage := FCurrentHint.Image;
  489.   if HImage = hiDefault then
  490.     HImage := FHintImage;
  491.   case HImage of
  492.     hiImage1:  Image := FHintImage1;
  493.     hiImage2:  Image := FHintImage2;
  494.     hiImage3:  Image := FHintImage3;
  495.     else       Image := nil;
  496.   end;
  497.   FHintImage1.Visible := HImage = hiImage1;
  498.   FHintImage2.Visible := HImage = hiImage2;
  499.   FHintImage3.Visible := HImage = hiImage3;
  500.   FHintLabel.Text     := FCurrentHint.Hint;
  501.   case FCurrentHint.Mode of
  502.     hmPoint: begin
  503.       Rect.TopLeft     := FCurrentHint.Point;
  504.       Rect.BottomRight := FCurrentHint.Point;
  505.     end;
  506.     hmRect: Rect := FCurrentHint.Rect;
  507.     hmComp: Rect := FCurrentHint.Comp.AbsoluteRect;
  508.   end;
  509.   Rect.NormalizeRect;
  510.   //FHintShortCuts
  511.  
  512.   if FCurrentHint.Mode = hmComp then begin
  513.     Form := TCustomForm(FCurrentHint.Comp);
  514.     while Assigned(Form) and not (TObject(Form) is TCustomForm) do
  515.       Form := TCustomForm(TControl(Form).Parent);
  516.     if not Assigned(Form) then
  517.       raise Exception.Create('Hint-ParentForm nicht gefunden.');
  518.   end else begin
  519.     if not (Self.Owner is TCustomForm) then
  520.       raise Exception.Create('Hint-ParentForm nicht gefunden.');
  521.     Form := TCustomForm(Self.Owner);
  522.   end;
  523.   FHintForm.DesignVisible := False;
  524.   FHintForm.Visible       := False;
  525.   FHintForm.Parent        := Form;
  526.   if Assigned(FOnShowHint) and FOnShowHint(Self, Form, Rect, FCurrentHint.Hint, FCurrentHint.Image, FCurrentHint.Comp) then
  527.     Exit;
  528.  
  529.   FHintLabel.WordWrap := not FHintLabel.WordWrap;
  530.   FHintLabel.WordWrap := not FHintLabel.WordWrap;
  531.   T := FHintLabel.FindStyleResource('text');
  532. //  if not (T is TText) then
  533. //    raise Exception.Create('unbekannter Fehler');
  534. //  if Assigned(TText(T).Canvas) then
  535.   if (T is TText) and Assigned(TText(T).Canvas) then
  536.     C := TText(T).Canvas
  537.   else
  538.     {$IF RTLVersion >= 24}
  539.     begin
  540.       if not Assigned(FMeasureBitmap) then
  541.         FMeasureBitmap := TBitmap.Create(1, 1);
  542.       C := FMeasureBitmap.Canvas;
  543.     end;
  544.     {$ELSE}
  545.     C := GetMeasureBitmap.Canvas;
  546.     {$ENDIF}
  547.   C.Font.Assign(FHintLabel.Font);
  548.   Size := RectF(0, 0, MaxSingle, MaxSingle);
  549.   if FHintLabel.WordWrap and (FMaxWidth > 5) then
  550.     Size.Right := FMaxWidth;
  551.   C.MeasureText(Size, FCurrentHint.Hint, FHintLabel.WordWrap and (FMaxWidth > 5), [], TTextAlign.taLeading, TTextAlign.taLeading);
  552.   FHintLabel.Width  := Size.Right  + 4;
  553.   FHintLabel.Height := Size.Bottom + 4;
  554.   if Assigned(Image) then begin
  555.     Size.Right  := Size.Right + Image.Width + 5;
  556.     Size.Bottom := Max(Size.Bottom, Image.Height + 4);
  557.   end;
  558.  
  559.   {$IF RTLVersion >= 24}
  560.   Size.Right  := Size.Right  + 6 + FHintForm.Stroke.Thickness * 2;
  561.   Size.Bottom := Size.Bottom + 4 + FHintForm.Stroke.Thickness * 2;
  562.   {$ELSE}
  563.   Size.Right  := Size.Right  + 6 + FHintForm.StrokeThickness * 2;
  564.   Size.Bottom := Size.Bottom + 4 + FHintForm.StrokeThickness * 2;
  565.   {$ENDIF}
  566.   if FHintPos in [hpRight, hpLeft] then
  567.     Size.Right  := Size.Right  + FHintForm.CalloutLength
  568.   else
  569.     Size.Bottom := Size.Bottom + FHintForm.CalloutLength;
  570.  
  571.   Pos    := FHintPos;
  572.   Offset := FHintForm.CalloutOffset;
  573.   case Pos of
  574.     hpBottom:
  575.       if (Rect.Bottom + Size.Height >= Form.Height) and (Rect.Top - Size.Height >= 0) then
  576.         Pos := hpTop;
  577.     hpRight:
  578.       if (Rect.Right + Size.Width >= Form.Width) and (Rect.Left - Size.Width >= 0) then
  579.         Pos := hpLeft;
  580.     hpTop:
  581.       if (Rect.Top - Size.Height < 0) and (Rect.Bottom + Size.Height < Form.Height) then
  582.         Pos := hpBottom;
  583.     hpLeft:
  584.       if (Rect.Left - Size.Width < 0) and (Rect.Right + Size.Width < Form.Width) then
  585.         Pos := hpRight;
  586.   end;
  587.   FHintForm.CalloutPosition := TCalloutPosition(Pos);
  588.  
  589.   if Abs(Offset) > 1 then
  590.     if Pos in [hpBottom, hpTop] then begin
  591.       if Offset > 0 then begin
  592.  
  593.       end else begin
  594.  
  595.       end;
  596.     end else begin
  597.       if Offset > 0 then begin
  598.  
  599.       end else begin
  600.  
  601.       end;
  602.     end;
  603.  
  604.   {$IF RTLVersion >= 24}
  605.   Size.Offset(FHintForm.Stroke.Thickness, FHintForm.Stroke.Thickness);
  606.   {$ELSE}
  607.   Size.Offset(FHintForm.StrokeThickness, FHintForm.StrokeThickness);
  608.   {$ENDIF}
  609.   case Pos of
  610.     hpBottom: Size.Offset(0, FHintForm.CalloutLength);
  611.     hpRight:  Size.Offset(FHintForm.CalloutLength, 0);
  612.   end;
  613.   if Assigned(Image) then begin
  614.     Image.Position.X := Size.Left + 3;
  615.     Image.Position.Y := Size.Top  + 2;
  616.     Size.Offset(Image.Width + 3, 0);
  617.   end;
  618.   FHintLabel.Position.X := Size.Left + 3;
  619.   FHintLabel.Position.Y := Size.Top  + 1;
  620.  
  621.   FHintForm.Width  := Size.Width;
  622.   FHintForm.Height := Size.Height;
  623.   case Pos of
  624.     hpBottom: FHintForm.Position.Y := Rect.Bottom;
  625.     hpRight:  FHintForm.Position.X := Rect.Right;
  626.     hpTop:    FHintForm.Position.Y := Rect.Top - Size.Height;
  627.     hpLeft:   FHintForm.Position.X := Rect.Left - Size.Width;
  628.   end;
  629.   case Pos of
  630.     hpBottom, hpTop:
  631.       if Offset = 0 then
  632.         FHintForm.Position.X := Rect.CenterPoint.X - Size.Width / 2
  633.       else if Offset > 0 then
  634.         FHintForm.Position.X := Rect.CenterPoint.X - Offset - FHintForm.CalloutWidth / 2
  635.       else
  636.         FHintForm.Position.X := Rect.CenterPoint.X + Offset + FHintForm.CalloutWidth / 2 - Size.Width;
  637.     hpRight, hpLeft:
  638.       if Offset = 0 then
  639.         FHintForm.Position.Y := Rect.CenterPoint.Y - Size.Height / 2
  640.       else if Offset > 0 then
  641.         FHintForm.Position.Y := Rect.CenterPoint.Y - Offset - FHintForm.CalloutWidth / 2
  642.       else
  643.         FHintForm.Position.Y := Rect.CenterPoint.Y + Offset + FHintForm.CalloutWidth / 2 - Size.Height;
  644.   end;
  645.  
  646.   if FFire and not (csDesigning in ComponentState) then begin
  647.     FFireTimer.Enabled   := True;
  648.     FHintShadow.Opacity  := 0.6;
  649.     FHintShadow.Softness := 0.8;
  650.     DoFireTimer(nil);
  651.   end;
  652.  
  653.   FHintHideTimer.Enabled  := False;
  654.   FHintHideTimer.Interval := FHintHidePause;
  655.   FHintHideTimer.Enabled  := True;
  656.   FHintForm.Parent        := Form;
  657.   FHintForm.Visible       := True;
  658.   FHintForm.BringToFront;
  659.   if csDesigning in ComponentState then begin
  660.     FHintImage1.DesignVisible := FHintImage1.Visible;
  661.     FHintImage2.DesignVisible := FHintImage2.Visible;
  662.     FHintImage3.DesignVisible := FHintImage3.Visible;
  663.     FHintForm.DesignVisible   := True;
  664.   end;
  665. end;
  666.  
  667. destructor THintManager.Destroy;
  668. begin
  669.   {$IF RTLVersion >= 24}
  670.   FMeasureBitmap.Free;
  671.   {$IFEND}
  672.   inherited;
  673. end;
  674.  
  675. procedure THintManager.DoFireTimer(Sender: TObject);
  676. begin
  677.   FHintShadow.Direction := 250 + Random(41);
  678.   FHintShadow.Distance  := 5   + Random(16);
  679.   case Random(5) of
  680.     0:   FHintShadow.ShadowColor := TAlphaColorRec.Orangered;
  681.     4:   FHintShadow.ShadowColor := TAlphaColorRec.Yellow;
  682.     else FHintShadow.ShadowColor := TAlphaColorRec.Orange;
  683.   end;
  684. end;
  685.  
  686. procedure THintManager.DoHideTimer(Sender: TObject);
  687. begin
  688.   FHintHideTimer.Enabled := False;
  689.   InnerHideHint(True, False);
  690. end;
  691.  
  692. procedure THintManager.DoShowTimer(Sender: TObject);
  693. begin
  694.   FHintShowTimer.Enabled := False;
  695.   InnerShowHint(hsImmediately);
  696. end;
  697.  
  698. function THintManager.GetAlignLayout: TAlignLayout;
  699. begin
  700.   Result := FHintLabel.Align;
  701. end;
  702.  
  703. function THintManager.GetBitmap(I: Integer): TBitmap;
  704. begin
  705.   InnerHideHint(True, False);
  706.   case I of
  707.     40:  Result := FHintImage1.Bitmap;
  708.     45:  Result := FHintImage2.Bitmap;
  709.     50:  Result := FHintImage3.Bitmap;
  710.     else Result := nil;
  711.   end;
  712. end;
  713.  
  714. function THintManager.GetBoolean(I: Integer): Boolean;
  715. begin
  716.   case I of
  717.     66:  Result := FHintLabel.WordWrap;
  718.     70:  Result := FHintGlow.Enabled;
  719.     80:  Result := FHintShadow.Enabled;
  720.     90:  Result := FFire;
  721.     else Result := False;
  722.   end;
  723. end;
  724.  
  725. function THintManager.GetBrBitmap: TBrushBitmap;
  726. begin
  727.   InnerHideHint(True, False);
  728.   Result := FHintForm.Fill.Bitmap;
  729. end;
  730.  
  731. function THintManager.GetColor(I: Integer): TAlphaColor;
  732. begin
  733.   case I of
  734.     21:  Result := FHintForm.Fill.Color;
  735.     31:  Result := FHintForm.Stroke.Color;
  736.     71:  Result := FHintGlow.GlowColor;
  737.     81:  Result := FHintShadow.ShadowColor;
  738.     else Result := TAlphaColorRec.Null;
  739.   end;
  740. end;
  741.  
  742. function THintManager.GetFontName: TFontName;
  743. begin
  744.   Result := FHintLabel.Font.Family;
  745. end;
  746.  
  747. function THintManager.GetFontStyle: TFontStyles;
  748. begin
  749.   Result := FHintLabel.Font.Style;
  750. end;
  751.  
  752. function THintManager.GetGradient(I: Integer): TGradient;
  753. begin
  754.   InnerHideHint(True, False);
  755.   case I of
  756.     22:  Result := FHintForm.Fill.Gradient;
  757.     32:  Result := FHintForm.Stroke.Gradient;
  758.     else Result := nil;
  759.   end;
  760. end;
  761.  
  762. function THintManager.GetKind(I: Integer): TBrushKind;
  763. begin
  764.   case I of
  765.     20:  Result := FHintForm.Fill.Kind;
  766.     30:  Result := FHintForm.Stroke.Kind;
  767.     else Result := TBrushKind.bkNone;
  768.   end;
  769. end;
  770.  
  771. function THintManager.GetSingle(I: Integer): Single;
  772. begin
  773.   case I of
  774.     10:  Result := FHintForm.CalloutLength;
  775.     11:  if FHintForm.CalloutOffset = 0 then
  776.            Result := 0
  777.          else if Abs(FHintForm.CalloutOffset) < 1 then
  778.            Result := Sign(FHintForm.CalloutOffset)
  779.          else
  780.            Result := FHintForm.CalloutOffset - Sign(FHintForm.CalloutOffset);
  781.     12:  Result := FHintForm.CalloutWidth;
  782.     33:  Result := FHintForm.{$IF RTLVersion >= 24}Stroke.Thickness{$ELSE}StrokeThickness{$ENDIF};
  783.     41:  Result := FHintImage1.Width;
  784.     42:  Result := FHintImage1.Height;
  785.     46:  Result := FHintImage2.Width;
  786.     47:  Result := FHintImage2.Height;
  787.     51:  Result := FHintImage3.Width;
  788.     52:  Result := FHintImage3.Height;
  789.     61:  Result := FHintLabel.Font.Size;
  790.     72:  Result := FHintGlow.Opacity;
  791.     73:  Result := FHintGlow.Softness;
  792.     82:  Result := FHintShadow.Direction;
  793.     83:  Result := FHintShadow.Distance;
  794.     84:  Result := FHintShadow.Opacity;
  795.     85:  Result := FHintShadow.Softness;
  796.     else Result := 0;
  797.   end;
  798. end;
  799.  
  800. function THintManager.GetString(I: Integer): String;
  801. begin
  802.   case I of
  803.     63:  Result := FHintLabel.StyleLookup;
  804.     64:  Result := FHintLabel.StyleName;
  805.     74:  Result := FHintGlow.StyleName;
  806.     86:  Result := FHintShadow.StyleName;
  807.     else Result := '';
  808.   end;
  809. end;
  810.  
  811. function THintManager.GetWrapMode(I: Integer): TImageWrapMode;
  812. begin
  813.   case I of
  814.     43:  Result := FHintImage1.WrapMode;
  815.     48:  Result := FHintImage2.WrapMode;
  816.     53:  Result := FHintImage3.WrapMode;
  817.     else Result := TImageWrapMode.iwOriginal;
  818.   end;
  819. end;
  820.  
  821. procedure THintManager.HideHint;
  822. var
  823.   C: TComponent;
  824. begin
  825.   if Assigned(Owner) then
  826.     for C in Owner do
  827.       if C is THintManager then
  828.         THintManager(C).InnerHideHint(True, True)
  829.   else
  830.     InnerHideHint(True, True);
  831. end;
  832.  
  833. procedure THintManager.HintHide(Item: THintItem; Immediately: Boolean);
  834. begin
  835.   InnerHideHint(FCurrentHint.Comp = Item.Control, FNextHint.Comp = Item.Control);
  836. end;
  837.  
  838. procedure THintManager.HintRefresh(Item: THintItem);
  839. begin
  840.   if FCurrentHint.Comp = Item.Control then begin
  841.     FCurrentHint.Hint  := LoadText(Item, Item.AutoTranslate
  842.       or ((Item.Control is TStyledControl) and TStyledControl(Item.Control).AutoTranslate));
  843.     FCurrentHint.Image := Item.HintImage;
  844.     InnerShowHint(hsRefresh);
  845.   end;
  846.   if FNextHint.Comp = Item.Control then begin
  847.     FNextHint.Hint  := LoadText(Item, Item.AutoTranslate
  848.       or ((Item.Control is TStyledControl) and TStyledControl(Item.Control).AutoTranslate));
  849.     FNextHint.Image := Item.HintImage;
  850.   end;
  851. end;
  852.  
  853. procedure THintManager.HintShow(Item: THintItem; Immediately: Boolean);
  854. begin
  855.   if (FCurrentHint.Comp = Item.Control) and IsHintVisible then begin
  856.     //FHintHideTimer.UpdateTimer;  // Zeit neu starten
  857.     FHintHideTimer.Enabled := not FHintHideTimer.Enabled;
  858.     FHintHideTimer.Enabled := not FHintHideTimer.Enabled;
  859.     Exit;
  860.   end;
  861.   ChangeRefVar(FNextHint.Comp, Item.Control, Self);
  862.   FNextHint.Mode  := hmComp;
  863.   FNextHint.Hint  := LoadText(Item, Item.AutoTranslate
  864.     or ((Item.Control is TStyledControl) and TStyledControl(Item.Control).AutoTranslate));
  865.   FNextHint.Image := Item.HintImage;
  866.   if Immediately then
  867.     InnerShowHint(hsImmediately)
  868.   else if IsHintVisible then
  869.     InnerShowHint(hsShort)
  870.   else
  871.     InnerShowHint(hsNormal);
  872. end;
  873.  
  874. procedure THintManager.InnerHideHint(CurrentHint, NextHint: Boolean);
  875. begin
  876.   if CurrentHint and (FCurrentHint.Mode <> hmNone) then begin
  877.     FHintHideTimer.Enabled  := False;
  878.     FCurrentHint.Mode       := hmNone;
  879.     FHintForm.Visible       := False;
  880.     FHintForm.DesignVisible := False;
  881.     if FHintForm.Parent is TControl then
  882.       TControl(FHintForm.Parent).Repaint;
  883.     if csDesigning in ComponentState then
  884.       FHintForm.Parent      := nil;
  885.     ChangeRefVar(FCurrentHint.Comp, nil, Self);
  886.     if Assigned(FOnHideHint) then
  887.       FOnHideHint(Self);
  888.     if FFireTimer.Enabled and not (csDesigning in ComponentState) then begin
  889.       FFireTimer.Enabled      := False;
  890.       FHintShadow.Opacity     := 0.6;
  891.       FHintShadow.Softness    := 0.3;
  892.       FHintShadow.Direction   := 45;
  893.       FHintShadow.Distance    := 1;
  894.       FHintShadow.ShadowColor := TAlphaColorRec.Black;
  895.     end;
  896.   end;
  897.   if NextHint and (FNextHint.Mode <> hmNone) then begin
  898.     FHintShowTimer.Enabled := False;
  899.     FNextHint.Mode         := hmNone;
  900.     ChangeRefVar(FNextHint.Comp, nil, Self);
  901.   end;
  902. end;
  903.  
  904. procedure THintManager.InnerShowHint(Mode: THintShow);
  905. var
  906.   C: TComponent;
  907. begin
  908.   case Mode of
  909.     hsImmediately: begin
  910.       InnerHideHint(True, False);
  911.       if Assigned(Owner) then
  912.         for C in Owner do
  913.           if (C is THintManager) and (C <> Self) then
  914.             THintManager(C).InnerHideHint(True, False);
  915.       ChangeRefVar(FCurrentHint.Comp, nil, Self);
  916.       FCurrentHint   := FNextHint;
  917.       FNextHint.Mode := hmNone;
  918.       FNextHint.Comp := nil;
  919.       CreateHint;
  920.     end;
  921.     hsShort: begin
  922.       if FHintShortPause = 0 then begin
  923.         InnerShowHint(hsImmediately);
  924.         Exit;
  925.       end;
  926.       FHintShowTimer.Enabled  := False;
  927.       FHintShowTimer.Interval := FHintShortPause;
  928.       FHintShowTimer.Enabled  := True;
  929.     end;
  930.     hsNormal: begin
  931.       FHintShowTimer.Enabled  := False;
  932.       FHintShowTimer.Interval := FHintPause;
  933.       FHintShowTimer.Enabled  := True;
  934.     end;
  935.     hsRefresh: begin
  936.       if not IsHintVisible then
  937.         Exit;
  938.       CreateHint;
  939.     end;
  940.   end;
  941. end;
  942.  
  943. function THintManager.IsHintVisible: Boolean;
  944. begin
  945.   Result := FHintForm.Visible or ((csDesigning in ComponentState) and FHintForm.DesignVisible)
  946. end;
  947.  
  948. function THintManager.LoadText(Comp: TComponent; AutoTranslate: Boolean): string;
  949. begin
  950.   if Comp is THintItem then
  951.     Result := THintItem(Comp).HintText
  952.   else if Comp is TTextControl then
  953.     Result := TTextControl(Comp).Text
  954.   else
  955.     raise EProgrammerNotFound.CreateFmt('%s.Text ist nicht implementiert.', [Comp.ClassName]);
  956.   if Result <> '' then
  957.     Result := Fmx.Types.Translate(Result);
  958. end;
  959.  
  960. procedure THintManager.Notification(Component: TComponent; Operation: TOperation);
  961. begin
  962.   inherited;
  963.   if (Operation = opRemove) and (Component = FCurrentHint.Comp) then begin
  964.     FCurrentHint.Comp := nil;
  965.     InnerHideHint(True, False);
  966.   end;
  967.   if (Operation = opRemove) and (Component = FNextHint.Comp) then begin
  968.     FNextHint.Comp := nil;
  969.     InnerHideHint(False, True);
  970.   end;
  971. end;
  972.  
  973. procedure THintManager.Repaint;
  974. begin
  975.   if IsHintVisible then
  976.     FHintForm.Repaint;
  977. end;
  978.  
  979. procedure THintManager.SetAlignLayout(Value: TAlignLayout);
  980. begin
  981.   InnerHideHint(True, False);
  982.   FHintLabel.Align := Value;
  983. end;
  984.  
  985. procedure THintManager.SetBoolean(I: Integer; Value: Boolean);
  986. begin
  987.   InnerHideHint(True, False);
  988.   case I of
  989.     66: FHintLabel.WordWrap     := Value;
  990.     70: begin
  991.           FHintGlow.Enabled     := Value;
  992.           if Value then
  993.             FHintShadow.Enabled := False;
  994.         end;
  995.     80: begin
  996.           FHintShadow.Enabled   := Value;
  997.           if Value then
  998.             FHintGlow.Enabled   := False;
  999.         end;
  1000.     90: FFire                   := Value;
  1001.   end;
  1002.   if FFire then begin
  1003.     FHintShadow.Enabled := True;
  1004.     FHintGlow.Enabled   := False;
  1005.   end;
  1006. end;
  1007.  
  1008. procedure THintManager.SetColor(I: Integer; Value: TAlphaColor);
  1009. begin
  1010.   InnerHideHint(True, False);
  1011.   case I of
  1012.     21: FHintForm.Fill.Color    := Value;
  1013.     31: FHintForm.Stroke.Color  := Value;
  1014.     71: FHintGlow.GlowColor     := Value;
  1015.     81: FHintShadow.ShadowColor := Value;
  1016.   end;
  1017. end;
  1018.  
  1019. procedure THintManager.SetFontName(Value: TFontName);
  1020. begin
  1021.   InnerHideHint(True, False);
  1022.   FHintLabel.Font.Family := Value;
  1023. end;
  1024.  
  1025. procedure THintManager.SetFontStyle(Value: TFontStyles);
  1026. begin
  1027.   InnerHideHint(True, False);
  1028.   FHintLabel.Font.Style := Value;
  1029. end;
  1030.  
  1031. procedure THintManager.SetHintImage(Value: THintImage);
  1032. begin
  1033.   InnerHideHint(True, False);
  1034.   if Value = hiDefault then
  1035.     Value := hiNone;
  1036.   FHintImage := Value;
  1037. end;
  1038.  
  1039. procedure THintManager.SetHintPos(Value: THintPos);
  1040. begin
  1041.   InnerHideHint(True, False);
  1042.   if Value = hpDefault then
  1043.     Value := hpTop;
  1044.   FHintPos := Value;
  1045. end;
  1046.  
  1047. procedure THintManager.SetKind(I: Integer; Value: TBrushKind);
  1048. begin
  1049.   InnerHideHint(True, False);
  1050.   case I of
  1051.     20: FHintForm.Fill.Kind   := Value;
  1052.     30: FHintForm.Stroke.Kind := Value;
  1053.   end;
  1054. end;
  1055.  
  1056. procedure THintManager.SetSingle(I: Integer; Value: Single);
  1057. begin
  1058.   InnerHideHint(True, False);
  1059.   case I of
  1060.     10:     Value := Min(Max(Value,    5),  50);
  1061.     11:     Value := Min(Max(Value, -250), 250);
  1062.     12:     Value := Min(Max(Value,    3), 100);
  1063.     33:     Value := Min(Max(Value,    1),  30);
  1064.     41..52: Value := Min(Max(Value,    0), 200);
  1065.     61:     Value := Min(Max(Value,    8), 100);
  1066.     67:     Value := Min(Max(Value,    0), 500);
  1067.     72, 73,
  1068.     84, 85: Value := Min(Max(Value,  0.3), 1.0);
  1069.     82:     Value := Min(Max(Value,    0), 360);
  1070.     83:     Value := Min(Max(Value,  0.1), 1.0);
  1071.   end;
  1072.   case I of
  1073.     10: FHintForm.CalloutLength   := Value;
  1074.     11: if Value = 0 then
  1075.           FHintForm.CalloutOffset := 0
  1076.         else if Abs(Value) <= 1.00000001 then
  1077.           FHintForm.CalloutOffset := Sign(Value) * 0.000000000000000000001
  1078.         else
  1079.           FHintForm.CalloutOffset := Value + Sign(Value);
  1080.     12: FHintForm.CalloutWidth    := Value;
  1081.     33: FHintForm.{$IF RTLVersion >= 24}Stroke.Thickness{$ELSE}StrokeThickness{$ENDIF} := Value;
  1082.     41: FHintImage1.Width         := Value;
  1083.     42: FHintImage1.Height        := Value;
  1084.     46: FHintImage1.Width         := Value;
  1085.     47: FHintImage1.Height        := Value;
  1086.     51: FHintImage1.Width         := Value;
  1087.     52: FHintImage1.Height        := Value;
  1088.     61: FHintLabel.Font.Size      := Value;
  1089.     67: FMaxWidth                 := Value;
  1090.     72: FHintGlow.Opacity         := Value;
  1091.     73: FHintGlow.Softness        := Value;
  1092.     82: FHintShadow.Direction     := Value;
  1093.     83: FHintShadow.Distance      := Value;
  1094.     84: FHintShadow.Opacity       := Value;
  1095.     85: FHintShadow.Softness      := Value;
  1096.   end;
  1097. end;
  1098.  
  1099. procedure THintManager.SetString(I: Integer; Value: String);
  1100. begin
  1101.   InnerHideHint(True, False);
  1102.   case I of
  1103.     63: FHintLabel.StyleLookup := Value;
  1104.     64: FHintLabel.StyleName   := Value;
  1105.     74: FHintGlow.StyleName    := Value;
  1106.     86: FHintShadow.StyleName  := Value;
  1107.   end;
  1108. end;
  1109.  
  1110. procedure THintManager.SetWrapMode(I: Integer; Value: TImageWrapMode);
  1111. begin
  1112.   InnerHideHint(True, False);
  1113.   case I of
  1114.     43: FHintImage1.WrapMode := Value;
  1115.     48: FHintImage2.WrapMode := Value;
  1116.     53: FHintImage3.WrapMode := Value;
  1117.   end;
  1118. end;
  1119.  
  1120. procedure THintManager.ShowHint(const AbsolutePos: TPointF; Hint: string; Image: THintImage; Translate: Boolean);
  1121. begin
  1122.   if Translate and (Hint <> '') then
  1123.     Hint := Fmx.Types.Translate(Hint);
  1124.   ChangeRefVar(FNextHint.Comp, nil, Self);
  1125.   FNextHint.Mode  := hmPoint;
  1126.   FNextHint.Point := AbsolutePos;
  1127.   FNextHint.Hint  := Hint;
  1128.   FNextHint.Image := Image;
  1129.   InnerShowHint(hsImmediately);
  1130. end;
  1131.  
  1132. procedure THintManager.ShowHint(const AbsolutePos: TRectF; Hint: string; Image: THintImage; Translate: Boolean);
  1133. begin
  1134.   if Translate and (Hint <> '') then
  1135.     Hint := Fmx.Types.Translate(Hint);
  1136.   ChangeRefVar(FNextHint.Comp, nil, Self);
  1137.   FNextHint.Mode  := hmRect;
  1138.   FNextHint.Rect  := AbsolutePos;
  1139.   FNextHint.Hint  := Hint;
  1140.   FNextHint.Image := Image;
  1141.   InnerShowHint(hsImmediately);
  1142. end;
  1143.  
  1144. procedure THintManager.ShowHint(Component: TControl; Hint: string; Image: THintImage; Translate: Boolean);
  1145. begin
  1146.   if Assigned(Component) then begin
  1147.     if Hint = '' then
  1148.       Exit;
  1149.       //Hint := LoadText(Component, Translate or ((Component is TStyledControl) and TStyledControl(Component).AutoTranslate));
  1150.     ChangeRefVar(FNextHint.Comp, Component, Self);
  1151.     FNextHint.Mode  := hmComp;
  1152.     FNextHint.Hint  := Hint;
  1153.     FNextHint.Image := Image;
  1154.     InnerShowHint(hsImmediately);
  1155.   end else begin
  1156.     ChangeRefVar(FNextHint.Comp, nil, Self);
  1157.     FNextHint.Mode  := hmNone;
  1158.   end;
  1159. end;
  1160.  
  1161. { THintItem }
  1162.  
  1163. type THackControl = class(TControl);
  1164.  
  1165. procedure ApplyTriggerEffect(Instance: TFmxObject; const Trigger: string);
  1166. begin
  1167.   inherited;
  1168.   if Assigned(Parent) and Assigned(FManager) {and (Instance = Parent)} and (Trigger = 'IsMouseOver') then
  1169.     if TControl(Parent).IsMouseOver and FHintVisible then
  1170.       FManager.HintShow(Self)
  1171.     else
  1172.       FManager.HintHide(Self);
  1173. end;
  1174.  
  1175. procedure THintItem.BeginAutoDrag;
  1176. begin
  1177. end;
  1178.  
  1179. {$IF RTLVersion >= 24}
  1180. procedure THintItem.BeginUpdate;
  1181. begin
  1182. end;
  1183. {$IFEND}
  1184.  
  1185. function THintItem.CheckForAllowFocus: Boolean;
  1186. begin
  1187.   Result := False;
  1188. end;
  1189.  
  1190. constructor THintItem.Create(Owner: TComponent);
  1191. begin
  1192.   inherited;
  1193.   FHintVisible := True;
  1194.   FTranslate   := True;
  1195. end;
  1196.  
  1197. procedure THintItem.DialogKey(var Key: Word; Shift: TShiftState);
  1198. begin
  1199. end;
  1200.  
  1201. procedure THintItem.DoEnter;
  1202. begin
  1203. end;
  1204.  
  1205. procedure THintItem.DoExit;
  1206. begin
  1207. end;
  1208.  
  1209. procedure THintItem.DoMouseEnter;
  1210. begin
  1211.   ShowMessage('THintItem.DoMouseEnter');
  1212. end;
  1213.  
  1214. procedure THintItem.DoMouseLeave;
  1215. begin
  1216.   ShowMessage('THintItem.DoMouseLeave');
  1217. end;
  1218.  
  1219. procedure THintItem.DragDrop(const Data: TDragObject; const Point: TPointF);
  1220. begin
  1221. end;
  1222.  
  1223. procedure THintItem.DragEnd;
  1224. begin
  1225. end;
  1226.  
  1227. procedure THintItem.DragEnter(const Data: TDragObject; const Point: TPointF);
  1228. begin
  1229. end;
  1230.  
  1231. procedure THintItem.DragLeave;
  1232. begin
  1233. end;
  1234.  
  1235. procedure THintItem.DragOver(const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
  1236. begin
  1237. end;
  1238.  
  1239. {$IF RTLVersion >= 24}
  1240. procedure THintItem.EndUpdate;
  1241. begin
  1242. end;
  1243.  
  1244. function THintItem.EnterChildren(AObject: TControl): Boolean;
  1245. begin
  1246.   Result := False;
  1247. end;
  1248.  
  1249. function THintItem.ExitChildren(AObject: TControl): Boolean;
  1250. begin
  1251.   Result := False;
  1252. end;
  1253. {$IFEND}
  1254.  
  1255. function THintItem.FindTarget(P: TPointF; const Data: TDragObject): IControl;
  1256. begin
  1257. //  if Parent is TControl then
  1258. //    Result := THackControl(Parent).FindTarget(P, Data)
  1259. //  else
  1260.     Result := nil;
  1261. end;
  1262.  
  1263. function THintItem.GetControl: TControl;
  1264. begin
  1265.   if Parent is TControl then
  1266.     Result := Parent as TControl
  1267.   else
  1268.     Result := nil;
  1269. end;
  1270.  
  1271. function THintItem.GetAcceptsControls: Boolean;
  1272. begin
  1273.   Result := False;
  1274. end;
  1275.  
  1276. function THintItem.GetCursor: TCursor;
  1277. begin
  1278.   Result := crNone;
  1279. end;
  1280.  
  1281. function THintItem.GetDesignInteractive: Boolean;
  1282. begin
  1283.   Result := False;
  1284. end;
  1285.  
  1286. function THintItem.GetDragMode: TDragMode;
  1287. begin
  1288.   Result := TDragMode.dmManual;
  1289. end;
  1290.  
  1291. function THintItem.GetHitTest: Boolean;
  1292. begin
  1293.   Result := False;
  1294. end;
  1295.  
  1296. {$IF RTLVersion >= 24}
  1297. function THintItem.GetIsChildFocused: Boolean;
  1298. begin
  1299.   Result := False;
  1300. end;
  1301. {$IFEND}
  1302.  
  1303. function THintItem.GetLocked: Boolean;
  1304. begin
  1305.   Result := True;
  1306. end;
  1307.  
  1308. function THintItem.GetObject: TFmxObject;
  1309. begin
  1310.   Result := Self;
  1311. end;
  1312.  
  1313. function THintItem.GetParent: TFmxObject;
  1314. begin
  1315.   Result := Parent;
  1316. end;
  1317.  
  1318. function THintItem.GetTabOrderValue: TTabOrder;
  1319. begin
  1320.   Result := -1;
  1321. end;
  1322.  
  1323. function THintItem.GetVisible: Boolean;
  1324. begin
  1325.   Result := FHintVisible;
  1326. end;
  1327.  
  1328. procedure THintItem.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  1329. begin
  1330. end;
  1331.  
  1332. procedure THintItem.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  1333. begin
  1334. end;
  1335.  
  1336. function THintItem.LocalToScreen(P: TPointF): TPointF;
  1337. begin
  1338. //  if Parent is TControl then
  1339. //    Result := THackControl(Parent).LocalToScreen(P)
  1340. //  else
  1341.     Result := P;
  1342. end;
  1343.  
  1344. procedure THintItem.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  1345. begin
  1346. end;
  1347.  
  1348. procedure THintItem.MouseMove(Shift: TShiftState; X, Y: Single);
  1349. begin
  1350. end;
  1351.  
  1352. procedure THintItem.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  1353. begin
  1354. end;
  1355.  
  1356. procedure THintItem.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
  1357. begin
  1358. end;
  1359.  
  1360. {$IF RTLVersion >= 24}
  1361. function THintItem.GetCanFocus: Boolean;
  1362. begin
  1363.   Result := False;
  1364. end;
  1365.  
  1366. function THintItem.GetCanParentFocus: Boolean;
  1367. begin
  1368.   Result := False;
  1369. end;
  1370. {$IFEND}
  1371.  
  1372. function THintItem.GetCHitTest: Boolean;
  1373. begin
  1374.   Result := (Parent is TControl) and TControl(Parent).HitTest;
  1375. end;
  1376.  
  1377. procedure THintItem.Notification(Component: TComponent; Operation: TOperation);
  1378. begin
  1379.   inherited;
  1380.   if (Operation = opRemove) and (Component = Parent) then begin
  1381.     Parent := nil;
  1382.     if not (csDestroying in ComponentState) then
  1383.       Free;
  1384.   end;
  1385.   if (Operation = opRemove) and (Component = FManager) then
  1386.     FManager := nil;
  1387. end;
  1388.  
  1389. function THintItem.ObjectAtPoint(P: TPointF): IControl;
  1390. begin
  1391. //  if Parent is TControl then
  1392. //    Result := THackControl(Parent).ObjectAtPoint(P)
  1393. //  else
  1394.     Result := nil;
  1395. end;
  1396.  
  1397. procedure THintItem.Repaint;
  1398. begin
  1399.   if Assigned(FManager) then
  1400.     FManager.Repaint;
  1401. end;
  1402.  
  1403. procedure THintItem.SetControl(Value: TControl);
  1404. var
  1405.   C: TComponent;
  1406.   F: TCustomForm;
  1407. begin
  1408.   if Parent = Value then
  1409.     Exit;
  1410.   Parent := Value;
  1411.   if not Assigned(FManager) then begin
  1412.     F := TCustomForm(Self);
  1413.     while Assigned(F) and not (TObject(F) is TCustomForm) do
  1414.       F := TCustomForm(TControl(F).Parent);
  1415.     if Assigned(F) then
  1416.       for C in Owner do
  1417.         if C is THintManager then begin
  1418.           Manager := THintManager(C);
  1419.           Break;
  1420.         end;
  1421.   end;
  1422. end;
  1423.  
  1424. procedure THintItem.SetDragMode(const ADragMode: TDragMode);
  1425. begin
  1426. end;
  1427.  
  1428. procedure THintItem.SetFocus;
  1429. begin
  1430. end;
  1431.  
  1432. procedure THintItem.SetHintImage(Value: THintImage);
  1433. begin
  1434.   FHintImage := Value;
  1435.   if Assigned(FManager) then
  1436.     FManager.HintRefresh(Self);
  1437. end;
  1438.  
  1439. procedure THintItem.SetHintText(Value: string);
  1440. begin
  1441.   FHintText := Value;
  1442.   if Assigned(FManager) then
  1443.     FManager.HintRefresh(Self);
  1444. end;
  1445.  
  1446. procedure THintItem.SetHintVisible(Value: Boolean);
  1447. begin
  1448.   FHintVisible := Value;
  1449.   if Assigned(FManager) then
  1450.     FManager.HintHide(Self, True);
  1451. end;
  1452.  
  1453. {$IF RTLVersion >= 24}
  1454. procedure THintItem.SetIsChildFocused(const Value: Boolean);
  1455. begin
  1456. end;
  1457. {$IFEND}
  1458.  
  1459. function THintItem.ScreenToLocal(P: TPointF): TPointF;
  1460. begin
  1461. //  if Parent is TControl then
  1462. //    Result := THackControl(Parent).ScreenToLocal(P)
  1463. //  else
  1464.     Result := P;
  1465. end;
  1466.  
  1467. procedure THintItem.SetCHitTest(Value: Boolean);
  1468. begin
  1469.   if Parent is TControl then
  1470.     TControl(Parent).HitTest := Value;
  1471. end;
  1472.  
  1473. procedure THintItem.SetManager(Value: THintManager);
  1474. begin
  1475.   if Assigned(FManager) then
  1476.     FManager.HintHide(Self, True);
  1477.   THintManager.ChangeRefVar(FManager, Value, Self);
  1478. end;
  1479.  
  1480. procedure THintItem.SetParent(const Value: TFmxObject);
  1481. begin
  1482.   if Value = inherited Parent then
  1483.     Exit;
  1484.   if Assigned(FManager) then
  1485.     FManager.HintHide(Self, True);
  1486. //  if Assigned(inherited Parent) and not (csDestroying in inherited Parent.ComponentState + Self.ComponentState) then
  1487. //    inherited Parent.RemoveFreeNotification(Self);
  1488.   inherited;
  1489. //  if Assigned(Value) then
  1490. //    Value.FreeNotification(Self);
  1491. end;
  1492.  
  1493. procedure THintItem.SetVisible(const Value: Boolean);
  1494. begin
  1495.   FHintVisible := Value;
  1496. end;
  1497.  
  1498. procedure THintItem.UpdateTabOrder(Value: TTabOrder);
  1499. begin
  1500. end;
  1501.  
  1502. initialization
  1503.   RegisterClass(THintItem);
  1504.  
  1505. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!