{"id":1431,"date":"2014-04-22T22:40:20","date_gmt":"2014-04-22T21:40:20","guid":{"rendered":"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1431"},"modified":"2014-04-22T23:12:45","modified_gmt":"2014-04-22T22:12:45","slug":"tulip-ui-controls-pas","status":"publish","type":"page","link":"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1431","title":{"rendered":"Tulip.UI.Controls.pas"},"content":{"rendered":"<div style=\"background-color: #FFFFFF; width: 680px\">\n<p style=\"text-align: right;\"><a title=\"Source Files\" href=\"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1091\">Source Files<\/a><\/p>\n<p><code><\/p>\n<pre>\r\n{******************************************************************************}\r\n{                                                                              }\r\n{                        Tulip - User Interface Library                        }\r\n{                                                                              }\r\n{         Copyright(c) 2012 - 2013 Marcos Gomes. All rights Reserved.          }\r\n{                                                                              }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{  This product is based on Asphyre Sphinx (c) 2000 - 2012  Yuriy Kotsarenko.  }\r\n{       All rights reserved. Official web site: http:\/\/www.afterwarp.net       }\r\n{                                                                              }\r\n{******************************************************************************}\r\n{                                                                              }\r\n{  Important Notice:                                                           }\r\n{                                                                              }\r\n{  If you modify\/use this code or one of its parts either in original or       }\r\n{  modified form, you must comply with Mozilla Public License Version 2.0,     }\r\n{  including section 3, \"Responsibilities\". Failure to do so will result in    }\r\n{  the license breach, which will be resolved in the court. Remember that      }\r\n{  violating author's rights either accidentally or intentionally is           }\r\n{  considered a serious crime in many countries. Thank you!                    }\r\n{                                                                              }\r\n{  !! Please *read* Mozilla Public License 2.0 document located at:            }\r\n{  http:\/\/www.mozilla.org\/MPL\/                                                 }\r\n{                                                                              }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{  The contents of this file are subject to the Mozilla Public License         }\r\n{  Version 2.0 (the \"License\"); you may not use this file except in            }\r\n{  compliance with the License. You may obtain a copy of the License at        }\r\n{  http:\/\/www.mozilla.org\/MPL\/                                                 }\r\n{                                                                              }\r\n{  Software distributed under the License is distributed on an \"AS IS\"         }\r\n{  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the     }\r\n{  License for the specific language governing rights and limitations          }\r\n{  under the License.                                                          }\r\n{                                                                              }\r\n{  The Original Code is Tulip.UI.Controls.pas.                                 }\r\n{                                                                              }\r\n{  The Initial Developer of the Original Code is Marcos Gomes.                 }\r\n{  Portions created by Marcos Gomes are Copyright (C) 2012, Marcos Gomes.      }\r\n{  All Rights Reserved.                                                        }\r\n{                                                                              }\r\n{******************************************************************************}\r\n{                                                                              }\r\n{  Tulip.UI.Controls.pas                                Modified: 23-Mar-2013  }\r\n{  --------------------------------------------------------------------------  }\r\n{                                                                              }\r\n{             Base Implementations for Controls and ControlManager             }\r\n{                                                                              }\r\n{                                Version 1.03                                  }\r\n{                                                                              }\r\n{******************************************************************************}\r\n\r\nunit Tulip.UI.Controls;\r\n\r\ninterface\r\n\r\nuses\r\n  Winapi.Windows, System.SysUtils, System.Classes,\r\n  \/\/ Asphyre units\r\n  AbstractDevices, AbstractCanvas, AsphyreArchives, AsphyreFonts, AsphyreImages,\r\n  AsphyreTypes,\r\n  \/\/ Tulip UI Units\r\n  Tulip.UI.Types, Tulip.UI.Classes, Tulip.UI.Utils, Tulip.UI.Helpers;\r\n\r\ntype\r\n{$REGION 'Forward declarations'}\r\n  TAControl = class;\r\n  TWControl = class;\r\n  TCustomManager = class;\r\n{$ENDREGION}\r\n{$REGION 'TAControl'}\r\n\r\n  TAControl = class(TComponent)\r\n  private\r\n    FControlManager: Pointer;\r\n    FControlState: TControlState;\r\n    FLeft: Integer;\r\n    FTop: Integer;\r\n    FWidth: Integer;\r\n    FHandle: Pointer;\r\n    FHeight: Integer;\r\n    FEnabled: Boolean;\r\n    FVisible: Boolean;\r\n    FParent: Pointer;\r\n\r\n    FOnClick: TNotifyEvent;\r\n    FOnDblClick: TNotifyEvent;\r\n    FOnMouseLeave: TNotifyEvent;\r\n    FOnMouseEnter: TNotifyEvent;\r\n    FOnMouseDown: TMouseEvent;\r\n    FOnMouseMove: TMouseMoveEvent;\r\n    FOnMouseUp: TMouseEvent;\r\n    FOnMouseWheel: TMouseWheelEvent;\r\n    FOnMouseWheelDown: TMouseWheelUpDownEvent;\r\n    FOnMouseWheelUp: TMouseWheelUpDownEvent;\r\n    FOnResize: TNotifyEvent;\r\n\r\n    FWheelAccumulator: Integer;\r\n\r\n    function GetControlManager: TCustomManager;\r\n    function GetParent: TWControl;\r\n\r\n    procedure SetVisible(Value: Boolean);\r\n    procedure SetZOrderPosition(Position: Integer);\r\n  protected\r\n    function GetClientLeft: Integer; virtual;\r\n    function GetClientRect: TRect; virtual;\r\n    function GetClientTop: Integer; virtual;\r\n    function GetEnabled: Boolean; virtual;\r\n    function GetHandle: TWControl; virtual;\r\n\r\n    procedure AssignTo(Dest: TPersistent); override;\r\n\r\n    procedure Paint; dynamic; abstract;\r\n    procedure ReadState(Reader: TReader); override;\r\n    procedure Resize; dynamic;\r\n\r\n    procedure SetControlManager(AControlManager: TCustomManager); virtual;\r\n    procedure SetEnabled(Value: Boolean); virtual;\r\n    procedure SetHeight(Value: Integer); virtual;\r\n    procedure SetLeft(Value: Integer); virtual;\r\n    procedure SetParent(AParent: TWControl); virtual;\r\n    procedure SetParentComponent(Value: TComponent); override;\r\n    procedure SetTop(Value: Integer); virtual;\r\n    procedure SetWidth(Value: Integer); virtual;\r\n    procedure SetZOrder(TopMost: Boolean); dynamic;\r\n  public\r\n    procedure Click; dynamic;\r\n    procedure DblClick; dynamic;\r\n    procedure MouseEnter; dynamic;\r\n    procedure MouseLeave; dynamic;\r\n    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;\r\n      X, Y: Integer); dynamic;\r\n    procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;\r\n    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;\r\n      X, Y: Integer); dynamic;\r\n    function MouseWheel(Shift: TShiftState; WheelDelta: Integer;\r\n      MousePos: TPoint): Boolean; dynamic;\r\n    function MouseWheelDown(Shift: TShiftState; MousePos: TPoint)\r\n      : Boolean; dynamic;\r\n    function MouseWheelUp(Shift: TShiftState; MousePos: TPoint)\r\n      : Boolean; dynamic;\r\n  public\r\n    constructor Create(AOwner: TComponent); override;\r\n    destructor Destroy; override;\r\n\r\n    function GetParentComponent: TComponent; override;\r\n    function IsVisible: Boolean; virtual;\r\n    function HasParent: Boolean; override;\r\n\r\n    procedure Assign(Source: TPersistent); override;\r\n    procedure BringToFront;\r\n    procedure SendToBack;\r\n    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;\r\n\r\n    property ClientLeft: Integer read GetClientLeft;\r\n    property ClientTop: Integer read GetClientTop;\r\n    property ClientRect: TRect read GetClientRect;\r\n    property ControlManager: TCustomManager read GetControlManager;\r\n    property ControlState: TControlState read FControlState write FControlState;\r\n    property Handle: TWControl read GetHandle;\r\n    property OnClick: TNotifyEvent read FOnClick write FOnClick;\r\n    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;\r\n    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;\r\n    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;\r\n    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;\r\n    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;\r\n    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;\r\n    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel\r\n      write FOnMouseWheel;\r\n    property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown\r\n      write FOnMouseWheelDown;\r\n    property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp\r\n      write FOnMouseWheelUp;\r\n    property OnResize: TNotifyEvent read FOnResize write FOnResize;\r\n    property Parent: TWControl read GetParent;\r\n    property WheelAccumulator: Integer read FWheelAccumulator\r\n      write FWheelAccumulator;\r\n  published\r\n    property Enabled: Boolean read GetEnabled write SetEnabled;\r\n    property Height: Integer read FHeight write SetHeight;\r\n    property Left: Integer read FLeft write SetLeft;\r\n    property Top: Integer read FTop write SetTop;\r\n    property Width: Integer read FWidth write SetWidth;\r\n    property Visible: Boolean read FVisible write SetVisible;\r\n  end;\r\n\r\n  TAControlClass = class of TAControl;\r\n{$ENDREGION}\r\n{$REGION 'TWControl'}\r\n\r\n  TWControl = class(TAControl)\r\n  private\r\n    FControls: TList;\r\n    FTabList: TList;\r\n    FTabStop: Boolean;\r\n    FWControls: TList;\r\n\r\n    FOnEnter: TNotifyEvent;\r\n    FOnExit: TNotifyEvent;\r\n    FOnKeyDown: TKeyEvent;\r\n    FOnKeyPress: TKeyPressEvent;\r\n    FOnKeyUp: TKeyEvent;\r\n\r\n    function GetControl(Index: Integer): TAControl;\r\n    function GetControlCount: Integer;\r\n    function GetTabOrder: TTabOrder;\r\n\r\n    procedure Insert(AControl: TAControl);\r\n    procedure Remove(AControl: TAControl);\r\n    procedure SetTabOrder(Value: TTabOrder);\r\n    procedure SetTabStop(Value: Boolean);\r\n    procedure SetZOrderPosition(Position: Integer);\r\n    procedure UpdateTabOrder(Value: TTabOrder);\r\n  protected\r\n    function FindNextControl(CurControl: TWControl;\r\n      GoForward, CheckTabStop, CheckParent: Boolean): TWControl;\r\n    function GetChildOwner: TComponent; override;\r\n\r\n    procedure AssignTo(Dest: TPersistent); override;\r\n    procedure Paint; override;\r\n    procedure SetChildOrder(Child: TComponent; Order: Integer); override;\r\n    procedure SetZOrder(TopMost: Boolean); override;\r\n  public\r\n    constructor Create(AOwner: TComponent); override;\r\n    destructor Destroy; override;\r\n\r\n    function CanFocus: Boolean; dynamic;\r\n    function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;\r\n      AllowWControls: Boolean = False; AllLevels: Boolean = False): TAControl;\r\n    function FindChildControl(const ControlName: string;\r\n      AllLevels: Boolean = False): TAControl;\r\n    function GetControls: TList;\r\n    function GetWControls: TList;\r\n\r\n    procedure DoEnter; dynamic;\r\n    procedure DoExit; dynamic;\r\n    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;\r\n    procedure GetTabOrderList(List: TList); dynamic;\r\n    procedure InsertControl(AControl: TAControl);\r\n    procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;\r\n    procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;\r\n    procedure KeyPress(var Key: Char); dynamic;\r\n    procedure RemoveControl(AControl: TAControl);\r\n    procedure SelectFirst;\r\n    procedure SelectNext(CurControl: TWControl;\r\n      GoForward, CheckTabStop: Boolean);\r\n    procedure SetFocus; virtual;\r\n\r\n    property Controls[Index: Integer]: TAControl read GetControl;\r\n    property ControlCount: Integer read GetControlCount;\r\n    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;\r\n    property OnExit: TNotifyEvent read FOnExit write FOnExit;\r\n    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;\r\n    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;\r\n    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;\r\n  published\r\n    property TabOrder: TTabOrder read GetTabOrder write SetTabOrder;\r\n    property TabStop: Boolean read FTabStop write SetTabStop;\r\n  end;\r\n\r\n  TWControlClass = class of TWControl;\r\n{$ENDREGION}\r\n{$REGION 'TWRoot'}\r\n\r\n  TWRoot = class(TWControl)\r\n  private\r\n    FFonts: TAStringList;\r\n    FImages: TAStringList;\r\n\r\n    procedure SetFonts(Value: TAStringList);\r\n    procedure SetImages(Value: TAStringList);\r\n  protected\r\n    procedure AssignTo(Dest: TPersistent); override;\r\n  public\r\n    constructor Create(AOwner: TComponent); override;\r\n    destructor Destroy; override;\r\n  published\r\n    property Fonts: TAStringList read FFonts write SetFonts;\r\n    property Images: TAStringList read FImages write SetImages;\r\n  end;\r\n{$ENDREGION}\r\n{$REGION 'TCustomManager'}\r\n\r\n  TCustomManager = class(TObject)\r\n  private\r\n    FDevice: TAsphyreDevice;\r\n    FCanvas: TAsphyreCanvas;\r\n    FImages: TAsphyreImages;\r\n    FFonts: TAsphyreFonts;\r\n\r\n    FActiveControl: TWControl;\r\n    FPrevControl: TAControl;\r\n    FRoot: TWRoot;\r\n    FActive: Boolean;\r\n    FLoading: Boolean;\r\n    FDesign: Boolean;\r\n\r\n    FOwnerClick: TNotifyEvent;\r\n    FOwnerDblClick: TNotifyEvent;\r\n    FOwnerKeyDown: TKeyEvent;\r\n    FOwnerKeyPress: TKeyPressEvent;\r\n    FOwnerKeyUp: TKeyEvent;\r\n    FOwnerMouseLeave: TNotifyEvent;\r\n    FOwnerMouseEnter: TNotifyEvent;\r\n    FOwnerMouseDown: TMouseEvent;\r\n    FOwnerMouseUp: TMouseEvent;\r\n    FOwnerMouseMove: TMouseMoveEvent;\r\n    FOwnerMouseWheel: TMouseWheelEvent;\r\n    FOwnerMouseWheelDown: TMouseWheelUpDownEvent;\r\n    FOwnerMouseWheelUp: TMouseWheelUpDownEvent;\r\n    FOwnerShortCut: TShortCutEvent;\r\n\r\n    procedure SetActiveControl(const Control: TWControl);\r\n    procedure SetDesign(const Value: Boolean);\r\n    procedure SetLoading(const Value: Boolean);\r\n\r\n  protected\r\n    FParent: TComponent;\r\n\r\n    procedure SetParent(const AParent: TComponent); virtual;\r\n\r\n    property OwnerClick: TNotifyEvent read FOwnerClick write FOwnerClick;\r\n    property OwnerDblClick: TNotifyEvent read FOwnerDblClick\r\n      write FOwnerDblClick;\r\n    property OwnerKeyDown: TKeyEvent read FOwnerKeyDown write FOwnerKeyDown;\r\n    property OwnerKeyPress: TKeyPressEvent read FOwnerKeyPress\r\n      write FOwnerKeyPress;\r\n    property OwnerKeyUp: TKeyEvent read FOwnerKeyUp write FOwnerKeyUp;\r\n    property OwnerMouseEnter: TNotifyEvent read FOwnerMouseEnter\r\n      write FOwnerMouseEnter;\r\n    property OwnerMouseLeave: TNotifyEvent read FOwnerMouseLeave\r\n      write FOwnerMouseLeave;\r\n\r\n    property OwnerMouseDown: TMouseEvent read FOwnerMouseDown\r\n      write FOwnerMouseDown;\r\n    property OwnerMouseUp: TMouseEvent read FOwnerMouseUp write FOwnerMouseUp;\r\n    property OwnerMouseMove: TMouseMoveEvent read FOwnerMouseMove\r\n      write FOwnerMouseMove;\r\n\r\n    property OwnerMouseWheel: TMouseWheelEvent read FOwnerMouseWheel\r\n      write FOwnerMouseWheel;\r\n    property OwnerMouseWheelDown: TMouseWheelUpDownEvent\r\n      read FOwnerMouseWheelDown write FOwnerMouseWheelDown;\r\n    property OwnerMouseWheelUp: TMouseWheelUpDownEvent read FOwnerMouseWheelUp\r\n      write FOwnerMouseWheelUp;\r\n    property OwnerShortCut: TShortCutEvent read FOwnerShortCut\r\n      write FOwnerShortCut;\r\n  public\r\n    constructor Create(const AOwner: TComponent; const ADevice: TAsphyreDevice;\r\n      const ACanvas: TAsphyreCanvas); virtual;\r\n\r\n    destructor Destroy; override;\r\n\r\n    function LoadFromArchive(const Archive: TAsphyreArchive): Boolean;\r\n    function LoadFromArchiveFile(const FileName: string): Boolean;\r\n\r\n    function SaveToArchive(const Archive: TAsphyreArchive): Boolean;\r\n    function SaveToArchiveFile(const FileName: string): Boolean;\r\n\r\n    procedure Render; \/\/ Render all Controls.\r\n    procedure Clear;\r\n\r\n    property Active: Boolean read FActive write FActive;\r\n    property ActiveControl: TWControl read FActiveControl\r\n      write SetActiveControl;\r\n    property PreviousControl: TAControl read FPrevControl write FPrevControl;\r\n\r\n    property DesignMode: Boolean read FDesign write SetDesign;\r\n    property Loading: Boolean read FLoading write SetLoading;\r\n\r\n    property Root: TWRoot read FRoot;\r\n    \/\/ The root container that contains all the components\r\n\r\n    property Device: TAsphyreDevice read FDevice write FDevice;\r\n    property Canvas: TAsphyreCanvas read FCanvas write FCanvas;\r\n    property Fonts: TAsphyreFonts read FFonts write FFonts;\r\n    property Images: TAsphyreImages read FImages;\r\n    property Parent: TComponent read FParent write SetParent;\r\n  end;\r\n\r\n  TCustomManagerClass = class of TCustomManager;\r\n{$ENDREGION}\r\n\r\nvar\r\n  VirtualPoint: TPoint;\r\n\r\nimplementation\r\n\r\n{$REGION 'TAControl'}\r\n  { TAControl }\r\n\r\nprocedure TAControl.Assign(Source: TPersistent);\r\nbegin\r\n  ControlState := ControlState + [csReadingState];\r\n  inherited;\r\n  ControlState := ControlState - [csReadingState];\r\nend;\r\n\r\nprocedure TAControl.AssignTo(Dest: TPersistent);\r\nbegin\r\n  if Dest is TAControl then\r\n    with TAControl(Dest) do\r\n    begin\r\n      \/\/ inherited properties\r\n      try\r\n        Name := Self.Name;\r\n      except\r\n        on EComponentError do\r\n        begin\r\n        end;\r\n      end;\r\n      Tag := Self.Tag;\r\n\r\n      Enabled := Self.Enabled;\r\n      Height := Self.Height;\r\n      Left := Self.Left;\r\n      OnClick := Self.OnClick;\r\n      OnDblClick := Self.OnDblClick;\r\n      OnMouseLeave := Self.OnMouseLeave;\r\n      OnMouseEnter := Self.OnMouseEnter;\r\n      OnMouseDown := Self.OnMouseDown;\r\n      OnMouseMove := Self.OnMouseMove;\r\n      OnMouseUp := Self.OnMouseUp;\r\n      OnMouseWheel := Self.OnMouseWheel;\r\n      OnMouseWheelDown := Self.OnMouseWheelDown;\r\n      OnMouseWheelUp := Self.OnMouseWheelUp;\r\n      OnResize := Self.OnResize;\r\n      Top := Self.Top;\r\n      WheelAccumulator := Self.WheelAccumulator;\r\n      Width := Self.Width;\r\n      Visible := Self.Visible;\r\n    end\r\n  else\r\n    inherited AssignTo(Dest);\r\n\r\nend;\r\n\r\nprocedure TAControl.BringToFront;\r\nbegin\r\n  SetZOrder(True);\r\nend;\r\n\r\nprocedure TAControl.Click;\r\nvar\r\n  BoundsRect: TRect;\r\nbegin\r\n  BoundsRect := Rect(ClientLeft, ClientTop, ClientLeft + Width,\r\n    ClientTop + Height);\r\n\r\n  if (PtInRect(BoundsRect, VirtualPoint)) then\r\n    if Assigned(FOnClick) then\r\n      FOnClick(Self);\r\nend;\r\n\r\nconstructor TAControl.Create(AOwner: TComponent);\r\nbegin\r\n  inherited Create(AOwner);\r\n\r\n  FLeft := 0;\r\n  FTop := 0;\r\n  FWidth := 0;\r\n  FHeight := 0;\r\n  FHandle := Self;\r\n  FEnabled := True;\r\n  FVisible := True;\r\n\r\n  if (AOwner <> nil) and (AOwner <> Self) and (AOwner is TWControl) then\r\n  begin\r\n    TWControl(AOwner).InsertControl(Self);\r\n    SetControlManager(TWControl(AOwner).ControlManager);\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.DblClick;\r\nvar\r\n  BoundsRect: TRect;\r\nbegin\r\n  BoundsRect := Rect(ClientLeft, ClientTop, ClientLeft + Width,\r\n    ClientTop + Height);\r\n\r\n  if (PtInRect(BoundsRect, VirtualPoint)) then\r\n    if Assigned(FOnDblClick) then\r\n      FOnDblClick(Self);\r\nend;\r\n\r\ndestructor TAControl.Destroy;\r\nbegin\r\n\r\n  inherited;\r\nend;\r\n\r\nfunction TAControl.GetClientLeft: Integer;\r\nvar\r\n  Temp: TWControl;\r\nbegin\r\n  Temp := Parent;\r\n  Result := FLeft;\r\n  while Temp <> nil do\r\n  begin\r\n    Result := Result + Temp.FLeft;\r\n    Temp := Temp.Parent;\r\n  end;\r\nend;\r\n\r\nfunction TAControl.GetClientRect: TRect;\r\nbegin\r\n  Result.Left := 0;\r\n  Result.Top := 0;\r\n  Result.Right := Width;\r\n  Result.Bottom := Height;\r\nend;\r\n\r\nfunction TAControl.GetClientTop: Integer;\r\nvar\r\n  Temp: TWControl;\r\nbegin\r\n  Temp := Parent;\r\n  Result := FTop;\r\n  while Temp <> nil do\r\n  begin\r\n    Result := Result + Temp.FTop;\r\n    Temp := Temp.Parent;\r\n  end;\r\nend;\r\n\r\nfunction TAControl.GetControlManager: TCustomManager;\r\nbegin\r\n  Result := FControlManager;\r\nend;\r\n\r\nfunction TAControl.GetEnabled: Boolean;\r\nbegin\r\n  Result := FEnabled;\r\nend;\r\n\r\nfunction TAControl.GetHandle: TWControl;\r\nbegin\r\n  Result := FHandle;\r\nend;\r\n\r\nfunction TAControl.GetParent: TWControl;\r\nbegin\r\n  Result := FParent;\r\nend;\r\n\r\nfunction TAControl.GetParentComponent: TComponent;\r\nbegin\r\n  Result := FParent;\r\nend;\r\n\r\nfunction TAControl.HasParent: Boolean;\r\nbegin\r\n  Result := FParent <> nil;\r\nend;\r\n\r\nfunction TAControl.IsVisible: Boolean;\r\nvar\r\n  Temp: TAControl;\r\nbegin\r\n  Temp := Self;\r\n  Result := FVisible;\r\n  while Temp.Parent <> nil do\r\n  begin\r\n    Result := (Result and Temp.FVisible);\r\n    Temp := Temp.Parent;\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.MouseDown(Button: TMouseButton; Shift: TShiftState;\r\n  X, Y: Integer);\r\nbegin\r\n  Include(FControlState, csClicked);\r\n  \/\/ get the down point\r\n  VirtualPoint.X := X;\r\n  VirtualPoint.Y := Y;\r\n\r\n  if ControlManager.ActiveControl <> Self then\r\n  begin\r\n    \/\/ Bring Handle to front and set focus\r\n    Handle.BringToFront;\r\n\r\n    if ControlManager.ActiveControl <> nil then\r\n    begin\r\n      if (Self is TWControl) then\r\n      begin\r\n        if TWControl(Self).FindChildControl(ControlManager.ActiveControl.Name) = nil\r\n        then\r\n        begin\r\n          TWControl(Self).SetFocus;\r\n          TWControl(Self).SelectFirst;\r\n        end;\r\n      end\r\n      else\r\n      begin\r\n        if Handle.FindChildControl(ControlManager.ActiveControl.Name) = nil then\r\n        begin\r\n          Handle.SetFocus;\r\n          Handle.SelectFirst;\r\n        end;\r\n      end;\r\n    end\r\n    else\r\n    begin\r\n      Handle.SetFocus;\r\n      Handle.SelectFirst;\r\n    end;\r\n  end;\r\n\r\n  if Assigned(FOnMouseDown) then\r\n    FOnMouseDown(Self, Button, Shift, X, Y);\r\nend;\r\n\r\nprocedure TAControl.MouseEnter;\r\nbegin\r\n  if Assigned(FOnMouseEnter) then\r\n    FOnMouseEnter(Self);\r\nend;\r\n\r\nprocedure TAControl.MouseLeave;\r\nbegin\r\n  if Assigned(FOnMouseLeave) then\r\n    FOnMouseLeave(Self);\r\nend;\r\n\r\nprocedure TAControl.MouseMove(Shift: TShiftState; X, Y: Integer);\r\nbegin\r\n  \/\/ get the current point\r\n  VirtualPoint.X := X;\r\n  VirtualPoint.Y := Y;\r\n\r\n  if Assigned(FOnMouseMove) then\r\n    FOnMouseMove(Self, Shift, X, Y);\r\nend;\r\n\r\nprocedure TAControl.MouseUp(Button: TMouseButton; Shift: TShiftState;\r\n  X, Y: Integer);\r\nbegin\r\n  Exclude(FControlState, csClicked);\r\n\r\n  \/\/ get the release point\r\n  VirtualPoint.X := X;\r\n  VirtualPoint.Y := Y;\r\n\r\n  if Assigned(FOnMouseUp) then\r\n    FOnMouseUp(Self, Button, Shift, X, Y);\r\nend;\r\n\r\nfunction TAControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer;\r\n  MousePos: TPoint): Boolean;\r\nvar\r\n  IsNeg: Boolean;\r\nbegin\r\n  Result := False;\r\n  if Assigned(FOnMouseWheel) then\r\n    FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);\r\n  if not Result then\r\n  begin\r\n    Inc(FWheelAccumulator, WheelDelta);\r\n    while Abs(FWheelAccumulator) >= WHEEL_DELTA do\r\n    begin\r\n      IsNeg := FWheelAccumulator < 0;\r\n      FWheelAccumulator := Abs(FWheelAccumulator) - WHEEL_DELTA;\r\n      if IsNeg then\r\n      begin\r\n        if FWheelAccumulator <> 0 then\r\n          FWheelAccumulator := -FWheelAccumulator;\r\n        Result := MouseWheelDown(Shift, MousePos);\r\n      end\r\n      else\r\n        Result := MouseWheelUp(Shift, MousePos);\r\n    end;\r\n  end;\r\nend;\r\n\r\nfunction TAControl.MouseWheelDown(Shift: TShiftState; MousePos: TPoint)\r\n  : Boolean;\r\nbegin\r\n  Result := False;\r\n  if Assigned(FOnMouseWheelDown) then\r\n    FOnMouseWheelDown(Self, Shift, MousePos, Result);\r\nend;\r\n\r\nfunction TAControl.MouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;\r\nbegin\r\n  Result := False;\r\n  if Assigned(FOnMouseWheelUp) then\r\n    FOnMouseWheelUp(Self, Shift, MousePos, Result);\r\nend;\r\n\r\nprocedure TAControl.ReadState(Reader: TReader);\r\nbegin\r\n  Include(FControlState, csReadingState);\r\n  inherited ReadState(Reader);\r\n  Exclude(FControlState, csReadingState);\r\nend;\r\n\r\nprocedure TAControl.Resize;\r\nbegin\r\n  if Assigned(FOnResize) then\r\n    FOnResize(Self);\r\nend;\r\n\r\nprocedure TAControl.SendToBack;\r\nbegin\r\n  SetZOrder(False);\r\nend;\r\n\r\nprocedure TAControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);\r\nbegin\r\n  if ((ALeft <> FLeft) or (ATop <> FTop) or (AWidth <> FWidth) or\r\n    (AHeight <> FHeight)) then\r\n  begin\r\n    FLeft := ALeft;\r\n    FTop := ATop;\r\n    FWidth := AWidth;\r\n    FHeight := AHeight;\r\n    \/\/ if not(csLoading in ComponentState) then\r\n    Resize;\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.SetControlManager(AControlManager: TCustomManager);\r\nbegin\r\n  FControlManager := AControlManager;\r\nend;\r\n\r\nprocedure TAControl.SetEnabled(Value: Boolean);\r\nbegin\r\n  if FEnabled <> Value then\r\n  begin\r\n    FEnabled := Value;\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.SetHeight(Value: Integer);\r\nbegin\r\n  SetBounds(FLeft, FTop, FWidth, Value);\r\nend;\r\n\r\nprocedure TAControl.SetLeft(Value: Integer);\r\nbegin\r\n  SetBounds(Value, FTop, FWidth, FHeight);\r\nend;\r\n\r\nprocedure TAControl.SetParent(AParent: TWControl);\r\nbegin\r\n  if FParent <> AParent then\r\n  begin\r\n    if AParent = Self then\r\n      Exit;\r\n    if FParent <> nil then\r\n      Parent.RemoveControl(Self);\r\n    if AParent <> nil then\r\n    begin\r\n      AParent.InsertControl(Self);\r\n    end;\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.SetParentComponent(Value: TComponent);\r\nbegin\r\n  if (Parent <> Value) and (Value is TWControl) then\r\n    SetParent(TWControl(Value));\r\nend;\r\n\r\nprocedure TAControl.SetTop(Value: Integer);\r\nbegin\r\n  SetBounds(FLeft, Value, FWidth, FHeight);\r\nend;\r\n\r\nprocedure TAControl.SetVisible(Value: Boolean);\r\nbegin\r\n  if FVisible <> Value then\r\n  begin\r\n    FVisible := Value;\r\n\r\n    \/\/ Execute events that possible haven't been executed yet.\r\n    if Value = False then\r\n    begin\r\n      MouseLeave;\r\n      if Self is TWControl then\r\n        TWControl(Self).DoExit;\r\n    end;\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.SetWidth(Value: Integer);\r\nbegin\r\n  SetBounds(FLeft, FTop, Value, FHeight);\r\nend;\r\n\r\nprocedure TAControl.SetZOrder(TopMost: Boolean);\r\nvar\r\n  AParent: TWControl;\r\nbegin\r\n  AParent := Parent;\r\n\r\n  if AParent <> nil then\r\n  begin\r\n    if TopMost then\r\n    begin\r\n      SetZOrderPosition(AParent.FControls.Count - 1)\r\n    end\r\n    else\r\n      SetZOrderPosition(0);\r\n  end;\r\nend;\r\n\r\nprocedure TAControl.SetZOrderPosition(Position: Integer);\r\nvar\r\n  I, Count: Integer;\r\n  AParent: TWControl;\r\nbegin\r\n  AParent := Parent;\r\n\r\n  if AParent <> nil then\r\n  begin\r\n    I := AParent.FControls.IndexOf(Self);\r\n    if I >= 0 then\r\n    begin\r\n      Count := AParent.FControls.Count;\r\n      if Position < 0 then\r\n        Position := 0;\r\n      if Position >= Count then\r\n        Position := Count - 1;\r\n      if Position <> I then\r\n      begin\r\n        AParent.FControls.Delete(I);\r\n        AParent.FControls.Insert(Position, Self);\r\n      end;\r\n    end;\r\n  end;\r\nend;\r\n{$ENDREGION}\r\n{$REGION 'TWControl'}\r\n{ TWControl }\r\n\r\nprocedure TWControl.AssignTo(Dest: TPersistent);\r\nvar\r\n  I: Integer;\r\n  AClass: TAControlClass;\r\n  Control: TAControl;\r\nbegin\r\n  inherited AssignTo(Dest);\r\n\r\n  if Dest is TWControl then\r\n    with TWControl(Dest) do\r\n    begin\r\n      TabStop := Self.TabStop;\r\n      OnEnter := Self.OnEnter;\r\n      OnExit := Self.OnExit;\r\n      OnKeyDown := Self.OnKeyDown;\r\n      OnKeyPress := Self.OnKeyPress;\r\n      OnKeyUp := Self.OnKeyUp;\r\n\r\n      if Self.ControlCount <> 0 then\r\n      begin\r\n        for I := 0 to Self.ControlCount - 1 do\r\n        begin\r\n          AClass := TAControlClass(Self.Controls[I].ClassType);\r\n          Control := AClass.Create(TWControl(Dest));\r\n          Control.Assign(Self.Controls[I]);\r\n        end;\r\n      end;\r\n    end;\r\nend;\r\n\r\nfunction TWControl.CanFocus: Boolean;\r\nvar\r\n  Control: TWControl;\r\nbegin\r\n  Result := False;\r\n\r\n  Control := Self;\r\n  while Control.Parent <> ControlManager.Root do\r\n  begin\r\n    if not(Control.FVisible and Control.Enabled) then\r\n      Exit;\r\n    Control := Control.Parent;\r\n  end;\r\n  Result := True;\r\n\r\nend;\r\n\r\nfunction TWControl.ControlAtPos(const Pos: TPoint;\r\n  AllowDisabled, AllowWControls, AllLevels: Boolean): TAControl;\r\nvar\r\n  I: Integer;\r\n  P: TPoint;\r\n  LControl: TAControl;\r\n\r\n  function GetControlAtPos(AControl: TAControl): Boolean;\r\n  begin\r\n    with AControl do\r\n    begin\r\n      P := Point(Pos.X - ClientLeft, Pos.Y - ClientTop);\r\n      Result := (PtInRect(ClientRect, P) and\r\n        (IsVisible or (IsVisible and (Enabled or AllowDisabled))))\r\n      { or ((IsVisible or (Parent <> ControlManager.Root)) and\r\n        PtInRect(ClientRect, P) and (ControlManager.DesignMode)) };\r\n      if Result then\r\n        LControl := AControl;\r\n    end;\r\n  end;\r\n\r\nbegin\r\n  LControl := nil;\r\n\r\n  \/\/ \/\/ do not check for child controls if self control is not visible\r\n  \/\/ if (IsVisible = false) {and\r\n  \/\/ ((Parent = ControlManager.Root) or (ControlManager.DesignMode = False))} then\r\n  \/\/ begin\r\n  \/\/ Result := LControl;\r\n  \/\/ Exit;\r\n  \/\/ end;\r\n\r\n  if AllowWControls and (FWControls <> nil) then\r\n    for I := FWControls.Count - 1 downto 0 do\r\n    begin\r\n      if AllLevels then\r\n        if TWControl(FWControls[I]).FWControls <> nil then\r\n          LControl := TWControl(FWControls[I]).ControlAtPos(Pos, AllowDisabled,\r\n            True, True);\r\n\r\n      \/\/ if found a WControl on Sub Level\r\n      if (LControl <> nil) then\r\n      begin\r\n        Break;\r\n      end;\r\n\r\n      \/\/ Not found on sub Level, check curent level\r\n      if (LControl = nil) and GetControlAtPos(TWControl(FWControls[I])) then\r\n        Break;\r\n\r\n    end;\r\n\r\n  \/\/ find FControls on result WControl\r\n  if (LControl <> nil) and (LControl is TWControl) then\r\n    if (TWControl(LControl).FControls <> nil) then\r\n      for I := TWControl(LControl).FControls.Count - 1 downto 0 do\r\n        if GetControlAtPos(TWControl(LControl).FControls[I]) then\r\n          Break;\r\n\r\n  \/\/ if nothing found and has FControls, search in FControls list\r\n  if (FControls <> nil) and (LControl = nil) then\r\n  begin\r\n    for I := FControls.Count - 1 downto 0 do\r\n      if GetControlAtPos(FControls[I]) then\r\n        Break;\r\n  end;\r\n\r\n  Result := LControl;\r\nend;\r\n\r\nconstructor TWControl.Create(AOwner: TComponent);\r\nbegin\r\n  inherited Create(AOwner);\r\n\r\n  FTabStop := False;\r\nend;\r\n\r\ndestructor TWControl.Destroy;\r\nvar\r\n  I: Integer;\r\n  Instance: TAControl;\r\nbegin\r\n  Destroying;\r\n\r\n  I := ControlCount;\r\n  while I <> 0 do\r\n  begin\r\n    Instance := Controls[I - 1];\r\n    Remove(Instance);\r\n    FreeAndNil(Instance);\r\n    I := ControlCount;\r\n  end;\r\n\r\n  inherited Destroy;\r\nend;\r\n\r\nprocedure TWControl.DoEnter;\r\nbegin\r\n  if Assigned(FOnEnter) then\r\n    FOnEnter(Self);\r\nend;\r\n\r\nprocedure TWControl.DoExit;\r\nbegin\r\n  if Assigned(FOnExit) then\r\n    FOnExit(Self);\r\nend;\r\n\r\nfunction TWControl.FindChildControl(const ControlName: string;\r\n  AllLevels: Boolean): TAControl;\r\nvar\r\n  I: Integer;\r\nbegin\r\n  Result := nil;\r\n\r\n  if FControls <> nil then\r\n    for I := 0 to FControls.Count - 1 do\r\n      if CompareText(TWControl(FControls[I]).Name, ControlName) = 0 then\r\n      begin\r\n        Result := TAControl(FControls[I]);\r\n        Exit;\r\n      end;\r\n\r\n  if FWControls <> nil then\r\n    for I := 0 to FWControls.Count - 1 do\r\n    begin\r\n      if CompareText(TWControl(FWControls[I]).Name, ControlName) = 0 then\r\n      begin\r\n        Result := TAControl(FWControls[I]);\r\n        Exit;\r\n      end;\r\n      if AllLevels = True then\r\n        if TWControl(FWControls[I]).FindChildControl(ControlName, AllLevels) <> nil\r\n        then\r\n        begin\r\n          Result := TWControl(FWControls[I]).FindChildControl(ControlName,\r\n            AllLevels);\r\n          Exit;\r\n        end;\r\n    end;\r\nend;\r\n\r\nfunction TWControl.FindNextControl(CurControl: TWControl;\r\n  GoForward, CheckTabStop, CheckParent: Boolean): TWControl;\r\nvar\r\n  I, StartIndex: Integer;\r\n  List: TList;\r\nbegin\r\n  Result := nil;\r\n  List := TList.Create;\r\n  try\r\n    GetTabOrderList(List);\r\n    if List.Count > 0 then\r\n    begin\r\n      StartIndex := List.IndexOf(CurControl);\r\n      if StartIndex = -1 then\r\n        if GoForward then\r\n          StartIndex := List.Count - 1\r\n        else\r\n          StartIndex := 0;\r\n      I := StartIndex;\r\n      repeat\r\n        if GoForward then\r\n        begin\r\n          Inc(I);\r\n          if I = List.Count then\r\n            I := 0;\r\n        end\r\n        else\r\n        begin\r\n          if I = 0 then\r\n            I := List.Count;\r\n          Dec(I);\r\n        end;\r\n        CurControl := TWControl(List[I]);\r\n        if CurControl.CanFocus and (not CheckTabStop or CurControl.TabStop) and\r\n          (not CheckParent or (CurControl.Parent = Self)) then\r\n          Result := CurControl;\r\n      until (Result <> nil) or (I = StartIndex);\r\n    end;\r\n  finally\r\n    List.Free;\r\n  end;\r\nend;\r\n\r\nfunction TWControl.GetChildOwner: TComponent;\r\nbegin\r\n  Result := Self;\r\nend;\r\n\r\nprocedure TWControl.GetChildren(Proc: TGetChildProc; Root: TComponent);\r\nvar\r\n  I: Integer;\r\n  Control: TAControl;\r\nbegin\r\n  for I := 0 to ControlCount - 1 do\r\n  begin\r\n    Control := Controls[I];\r\n    \/\/ if Control.Owner = Root then\r\n    Proc(Control);\r\n  end;\r\nend;\r\n\r\nfunction TWControl.GetControl(Index: Integer): TAControl;\r\nvar\r\n  N: Integer;\r\nbegin\r\n  if FControls <> nil then\r\n    N := FControls.Count\r\n  else\r\n    N := 0;\r\n  if Index < N then\r\n    Result := FControls[Index]\r\n  else\r\n    Result := FWControls[Index - N];\r\nend;\r\n\r\nfunction TWControl.GetControlCount: Integer;\r\nbegin\r\n  Result := 0;\r\n  if FControls <> nil then\r\n    Inc(Result, FControls.Count);\r\n  if FWControls <> nil then\r\n    Inc(Result, FWControls.Count);\r\nend;\r\n\r\nfunction TWControl.GetControls: TList;\r\nbegin\r\n  Result := FControls;\r\nend;\r\n\r\nfunction TWControl.GetTabOrder: TTabOrder;\r\nbegin\r\n  if FParent <> nil then\r\n    Result := Parent.FTabList.IndexOf(Self)\r\n  else\r\n    Result := -1;\r\nend;\r\n\r\nprocedure TWControl.GetTabOrderList(List: TList);\r\nvar\r\n  I: Integer;\r\n  Control: TWControl;\r\nbegin\r\n  if FTabList <> nil then\r\n    for I := 0 to FTabList.Count - 1 do\r\n    begin\r\n      Control := TWControl(FTabList[I]);\r\n      List.Add(Control);\r\n      Control.GetTabOrderList(List);\r\n    end;\r\nend;\r\n\r\nfunction TWControl.GetWControls: TList;\r\nbegin\r\n  Result := FWControls\r\nend;\r\n\r\nprocedure TWControl.Insert(AControl: TAControl);\r\nvar\r\n  Form: TWControl;\r\nbegin\r\n  if AControl <> nil then\r\n  begin\r\n    if AControl is TWControl then\r\n    begin\r\n      ListAdd(FWControls, AControl);\r\n      ListAdd(FTabList, AControl);\r\n    end\r\n    else\r\n      ListAdd(FControls, AControl);\r\n    AControl.FParent := Self;\r\n\r\n    \/\/ Get the parent Form from Engine.Root and set it as handler\r\n    Form := Self;\r\n    if (ControlManager <> nil) then\r\n    begin\r\n      if not(Form = ControlManager.Root) then\r\n      begin\r\n        while Form.Parent <> ControlManager.Root do\r\n          Form := Form.Parent;\r\n        AControl.FHandle := Form;\r\n      end\r\n      else\r\n      begin\r\n        AControl.FHandle := AControl;\r\n      end;\r\n    end;\r\n  end;\r\n\r\nend;\r\n\r\nprocedure TWControl.InsertControl(AControl: TAControl);\r\nbegin\r\n  AControl.ValidateContainer(Self);\r\n  Insert(AControl);\r\nend;\r\n\r\nprocedure TWControl.KeyDown(var Key: Word; Shift: TShiftState);\r\nbegin\r\n  if (Shift = [ssShift, ssCtrl]) or (Shift = [ssShift]) then\r\n  begin\r\n    case Key of\r\n      vk_Tab:\r\n        Self.Handle.SelectNext(Self, False, True);\r\n    end;\r\n  end;\r\n\r\n  if (Shift = [ssCtrl]) or (Shift = []) then\r\n  begin\r\n    case Key of\r\n      vk_Tab:\r\n        Self.Handle.SelectNext(Self, True, True);\r\n    end;\r\n  end;\r\n\r\n  if Assigned(FOnKeyDown) then\r\n    FOnKeyDown(Self, Key, Shift);\r\nend;\r\n\r\nprocedure TWControl.KeyPress(var Key: Char);\r\nbegin\r\n  if Assigned(FOnKeyPress) then\r\n    FOnKeyPress(Self, Key);\r\nend;\r\n\r\nprocedure TWControl.KeyUp(var Key: Word; Shift: TShiftState);\r\nbegin\r\n  if Assigned(FOnKeyUp) then\r\n    FOnKeyUp(Self, Key, Shift);\r\nend;\r\n\r\nprocedure TWControl.Paint;\r\nvar\r\n  Control, WControl: Integer;\r\nbegin\r\n  if FControls <> nil then\r\n  begin\r\n    for Control := 0 to FControls.Count - 1 do\r\n    begin\r\n      with TAControl(FControls[Control]) do\r\n        if (Visible) { or (Self.ControlManager.FDesign) } then\r\n          Paint;\r\n    end;\r\n  end;\r\n  if FWControls <> nil then\r\n  begin\r\n    for WControl := 0 to FWControls.Count - 1 do\r\n    begin\r\n      with TWControl(FWControls[WControl]) do\r\n        if (Visible) { or (Self.ControlManager.FDesign) } then\r\n          Paint;\r\n    end;\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.Remove(AControl: TAControl);\r\nbegin\r\n  if AControl is TWControl then\r\n  begin\r\n    ListRemove(FTabList, AControl);\r\n    ListRemove(FWControls, AControl);\r\n  end\r\n  else\r\n    ListRemove(FControls, AControl);\r\n  AControl.FParent := nil;\r\n  AControl.FHandle := AControl;\r\nend;\r\n\r\nprocedure TWControl.RemoveControl(AControl: TAControl);\r\nbegin\r\n  Remove(AControl);\r\nend;\r\n\r\nprocedure TWControl.SelectFirst;\r\nvar\r\n  Control: TWControl;\r\nbegin\r\n  Control := FindNextControl(nil, True, True, False);\r\n  if Control = nil then\r\n    Control := FindNextControl(nil, True, False, False);\r\n  if Control <> nil then\r\n  begin\r\n    Control.SetFocus;\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.SelectNext(CurControl: TWControl;\r\n  GoForward, CheckTabStop: Boolean);\r\nbegin\r\n  CurControl := FindNextControl(CurControl, GoForward, CheckTabStop,\r\n    not CheckTabStop);\r\n  if CurControl <> nil then\r\n    CurControl.SetFocus;\r\nend;\r\n\r\nprocedure TWControl.SetChildOrder(Child: TComponent; Order: Integer);\r\nbegin\r\n  if Child is TWControl then\r\n    TWControl(Child).SetZOrderPosition(Order)\r\n  else if Child is TAControl then\r\n    TAControl(Child).SetZOrderPosition(Order);\r\nend;\r\n\r\nprocedure TWControl.SetFocus;\r\nvar\r\n  Control: TWControl;\r\nbegin\r\n  Control := Self;\r\n  if Control.CanFocus then\r\n  begin\r\n    if ControlManager.ActiveControl <> nil then\r\n      if ControlManager.ActiveControl <> Control then\r\n        ControlManager.ActiveControl.DoExit;\r\n    ControlManager.ActiveControl := Control;\r\n    Control.DoEnter;\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.SetTabOrder(Value: TTabOrder);\r\nbegin\r\n  UpdateTabOrder(Value);\r\nend;\r\n\r\nprocedure TWControl.SetTabStop(Value: Boolean);\r\nbegin\r\n  if FTabStop <> Value then\r\n  begin\r\n    FTabStop := Value;\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.SetZOrder(TopMost: Boolean);\r\nvar\r\n  N, M: Integer;\r\nbegin\r\n  if FParent <> nil then\r\n  begin\r\n    if TopMost then\r\n      N := Parent.FWControls.Count - 1\r\n    else\r\n      N := 0;\r\n    M := 0;\r\n    if Parent.FControls <> nil then\r\n      M := Parent.FControls.Count;\r\n    SetZOrderPosition(M + N);\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.SetZOrderPosition(Position: Integer);\r\nvar\r\n  I, Count: Integer;\r\nbegin\r\n  if FParent <> nil then\r\n  begin\r\n    if Parent.FControls <> nil then\r\n      Dec(Position, Parent.FControls.Count);\r\n    I := Parent.FWControls.IndexOf(Self);\r\n    if I >= 0 then\r\n    begin\r\n      Count := Parent.FWControls.Count;\r\n      if Position < 0 then\r\n        Position := 0;\r\n      if Position >= Count then\r\n        Position := Count - 1;\r\n      if Position <> I then\r\n      begin\r\n        Parent.FWControls.Delete(I);\r\n        Parent.FWControls.Insert(Position, Self);\r\n      end;\r\n    end;\r\n  end;\r\nend;\r\n\r\nprocedure TWControl.UpdateTabOrder(Value: TTabOrder);\r\nvar\r\n  CurIndex, Count: Integer;\r\nbegin\r\n  CurIndex := GetTabOrder;\r\n  if CurIndex >= 0 then\r\n  begin\r\n    Count := Parent.FTabList.Count;\r\n    if Value < 0 then\r\n      Value := 0;\r\n    if Value >= Count then\r\n      Value := Count - 1;\r\n    if Value <> CurIndex then\r\n    begin\r\n      Parent.FTabList.Delete(CurIndex);\r\n      Parent.FTabList.Insert(Value, Self);\r\n    end;\r\n  end;\r\nend;\r\n{$ENDREGION}\r\n{$REGION 'TWRoot'}\r\n{ TWRoot }\r\n\r\nprocedure TWRoot.AssignTo(Dest: TPersistent);\r\nbegin\r\n  inherited AssignTo(Dest);\r\n\r\n  if Dest is TWRoot then\r\n    with TWRoot(Dest) do\r\n    begin\r\n      Fonts := Self.Fonts;\r\n      Images := Self.Images;\r\n    end;\r\nend;\r\n\r\nconstructor TWRoot.Create(AOwner: TComponent);\r\nbegin\r\n  inherited Create(AOwner);\r\n\r\n  FFonts := TAStringList.Create;\r\n  FImages := TAStringList.Create;\r\nend;\r\n\r\ndestructor TWRoot.Destroy;\r\nbegin\r\n  FFonts.Free;\r\n  FImages.Free;\r\n\r\n  inherited;\r\nend;\r\n\r\nprocedure TWRoot.SetFonts(Value: TAStringList);\r\nbegin\r\n  if (Value <> nil) then\r\n    FFonts.Assign(Value);\r\nend;\r\n\r\nprocedure TWRoot.SetImages(Value: TAStringList);\r\nbegin\r\n  if Value <> nil then\r\n    FImages.Assign(Value);\r\nend;\r\n\r\n{$ENDREGION}\r\n{$REGION 'TCustomManager'}\r\n{ TCustomManager }\r\n\r\nprocedure TCustomManager.Clear;\r\nvar\r\n  I: Integer;\r\n  Instance: TAControl;\r\nbegin\r\n  FActiveControl := nil;\r\n  FPrevControl := nil;\r\n\r\n  I := FRoot.ControlCount;\r\n  while I <> 0 do\r\n  begin\r\n    Instance := FRoot.Controls[I - 1];\r\n    FRoot.Remove(Instance);\r\n    FreeAndNil(Instance);\r\n    I := FRoot.ControlCount;\r\n  end;\r\n\r\n  \/\/ Clear Font and Image Lists\r\n  FRoot.Fonts.Clear;\r\n  FRoot.Images.Clear;\r\n\r\n  \/\/ free current fonts\r\n  FFonts.RemoveAll;\r\n  FFonts.Images.RemoveAll;\r\n  FFonts.Canvas := FCanvas;\r\n\r\n  \/\/ free current images\r\n  FImages.RemoveAll;\r\nend;\r\n\r\nconstructor TCustomManager.Create(const AOwner: TComponent;\r\n  const ADevice: TAsphyreDevice; const ACanvas: TAsphyreCanvas);\r\nbegin\r\n  FDevice := ADevice;\r\n  FCanvas := ACanvas;\r\n  FFonts := TAsphyreFonts.Create;\r\n  FFonts.Images := TAsphyreImages.Create;\r\n  FImages := TAsphyreImages.Create;\r\n  Parent := AOwner;\r\n\r\n  FRoot := TWRoot.Create(nil);\r\n  FRoot.Left := 0;\r\n  FRoot.Top := 0;\r\n\r\n  if ADevice <> nil then\r\n  begin\r\n    FRoot.Width := ADevice.SwapChains.Items[0].Width;\r\n    FRoot.Height := ADevice.SwapChains.Items[0].Height;\r\n  end\r\n  else\r\n  begin\r\n    FRoot.Width := 0;\r\n    FRoot.Height := 0;\r\n  end;\r\n\r\n  FRoot.FControlManager := Self;\r\n\r\n  FDesign := False;\r\n\r\n  FActive := True;\r\n  FLoading := False;\r\nend;\r\n\r\ndestructor TCustomManager.Destroy;\r\nbegin\r\n  FDevice := nil;\r\n  FCanvas := nil;\r\n  FParent := nil;\r\n\r\n  FFonts.Images.RemoveAll;\r\n  FFonts.Images.Free;\r\n  FImages.RemoveAll;\r\n  FreeAndNil(FFonts);\r\n  FreeAndNil(FImages);\r\n  FreeAndNil(FRoot);\r\n\r\n  inherited Destroy;\r\nend;\r\n\r\nfunction TCustomManager.LoadFromArchive(const Archive: TAsphyreArchive)\r\n  : Boolean;\r\nvar\r\n  AControl: TWRoot;\r\n  Stream: TMemoryStream;\r\n  I: Integer;\r\nbegin\r\n  \/\/ Clear all controls\r\n  Self.Clear;\r\n\r\n  Stream := TMemoryStream.Create();\r\n\r\n  Result := Archive.ReadMemStream('Interface.ui', Stream);\r\n\r\n  if Result = True then\r\n  begin\r\n    try\r\n      AControl := Stream.ReadComponent(nil) as TWRoot;\r\n      Root.Assign(AControl);\r\n    finally\r\n      FreeAndNil(AControl);\r\n    end;\r\n\r\n    \/\/ Set Device size again\r\n    if FDevice <> nil then\r\n    begin\r\n      FRoot.Width := FDevice.SwapChains.Items[0].Width;\r\n      FRoot.Height := FDevice.SwapChains.Items[0].Height;\r\n    end;\r\n\r\n    if FRoot.Fonts.Count > 0 then\r\n    begin\r\n      for I := 0 to FRoot.Fonts.Count - 1 do\r\n        FFonts.InsertFromArchive(FRoot.Fonts.Items[I], Archive, foFonts);\r\n    end;\r\n\r\n    if FRoot.Images.Count > 0 then\r\n    begin\r\n      for I := 0 to FRoot.Images.Count - 1 do\r\n        FImages.InsertFromArchive(FRoot.Images.Items[I], Archive, foImages);\r\n    end;\r\n  end;\r\n\r\n  Stream.Free();\r\nend;\r\n\r\nfunction TCustomManager.LoadFromArchiveFile(const FileName: string): Boolean;\r\nvar\r\n  Media: TAsphyreArchive;\r\nbegin\r\n  Media := TAsphyreArchive.Create;\r\n\r\n  ArchiveTypeAccess := ataAnyFile;\r\n  Media.OpenMode := aomReadOnly;\r\n\r\n  Result := Media.OpenFile(FileName);\r\n\r\n  if Result = True then\r\n  begin\r\n    LoadFromArchive(Media);\r\n  end;\r\n\r\n  Media.Free;\r\nend;\r\n\r\nprocedure TCustomManager.Render;\r\nbegin\r\n  if FLoading then\r\n    Exit;\r\n\r\n  FRoot.Paint;\r\nend;\r\n\r\nfunction TCustomManager.SaveToArchive(const Archive: TAsphyreArchive): Boolean;\r\nvar\r\n  Stream: TMemoryStream;\r\n  I: Integer;\r\nbegin\r\n  Result := False;\r\n\r\n  if Archive = nil then\r\n    Exit;\r\n\r\n  if (FFonts.Count > 0) then\r\n  begin\r\n    if not(FFonts.SaveAllToArchive(Archive, foFonts)) then\r\n    begin\r\n      Exit;\r\n    end;\r\n\r\n    FRoot.Fonts.Clear;\r\n    for I := 0 to FFonts.Count - 1 do\r\n    begin\r\n      FRoot.Fonts.Add(FFonts.Items[I].Name);\r\n    end;\r\n  end;\r\n\r\n  if (FImages.ItemCount > 0) then\r\n  begin\r\n    if not(FImages.SaveAllToArchive(Archive, foImages)) then\r\n    begin\r\n      Exit;\r\n    end;\r\n\r\n    FRoot.Images.Clear;\r\n    for I := 0 to FImages.ItemCount - 1 do\r\n    begin\r\n      if not (Assigned(Self.Images[I])) then\r\n      begin\r\n        Continue;\r\n      end;\r\n\r\n      FRoot.Images.Add(FImages.Items[I].Name);\r\n    end;\r\n  end;\r\n\r\n  Stream := TMemoryStream.Create();\r\n  Stream.WriteComponent(FRoot);\r\n\r\n  Result := Archive.WriteRecord('Interface.ui', Stream.Memory,\r\n    Stream.Size, artFile);\r\n\r\n  Stream.Free();\r\nend;\r\n\r\nfunction TCustomManager.SaveToArchiveFile(const FileName: string): Boolean;\r\nvar\r\n  Media: TAsphyreArchive;\r\nbegin\r\n  Media := TAsphyreArchive.Create;\r\n\r\n  ArchiveTypeAccess := ataAnyFile;\r\n  Media.OpenMode := aomOverwrite;\r\n\r\n  Result := Media.OpenFile(FileName);\r\n\r\n  if (Result = True) then\r\n  begin\r\n    SaveToArchive(Media);\r\n  end;\r\n\r\n  Media.Free;\r\nend;\r\n\r\nprocedure TCustomManager.SetActiveControl(const Control: TWControl);\r\nbegin\r\n  if FActiveControl <> Control then\r\n    FActiveControl := Control;\r\nend;\r\n\r\nprocedure TCustomManager.SetDesign(const Value: Boolean);\r\nbegin\r\n  if FDesign <> Value then\r\n    FDesign := Value;\r\nend;\r\n\r\nprocedure TCustomManager.SetLoading(const Value: Boolean);\r\nbegin\r\n  if FLoading <> Value then\r\n    FLoading := Value;\r\nend;\r\n\r\nprocedure TCustomManager.SetParent(const AParent: TComponent);\r\nbegin\r\n  if FParent <> AParent then\r\n  begin\r\n    FParent := AParent;\r\n  end;\r\nend;\r\n{$ENDREGION}\r\n\r\ninitialization\r\n\r\nRegisterClasses([TAControl, TWControl, TWRoot]);\r\n\r\nfinalization\r\n\r\nUnRegisterClasses([TAControl, TWControl, TWRoot]);\r\n\r\nend.\r\n<\/pre>\n<p><\/code>\n<\/div>\n","protected":false},"excerpt":{"rendered":"<p>Source Files {******************************************************************************} { } { Tulip &#8211; User Interface Library } { } { Copyright(c) 2012 &#8211; 2013 Marcos Gomes. All rights Reserved. } { } { &#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8211; } <a class=\"more-link\" href=\"http:\/\/tulip-ui.azurewebsites.net\/?page_id=1431\">Continue Reading &rarr;<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"parent":1091,"menu_order":0,"comment_status":"closed","ping_status":"open","template":"","meta":[],"_links":{"self":[{"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1431"}],"collection":[{"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages"}],"about":[{"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=1431"}],"version-history":[{"count":2,"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1431\/revisions"}],"predecessor-version":[{"id":1701,"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1431\/revisions\/1701"}],"up":[{"embeddable":true,"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=\/wp\/v2\/pages\/1091"}],"wp:attachment":[{"href":"http:\/\/tulip-ui.azurewebsites.net\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=1431"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}