{
 /***************************************************************************
                                  forms.pp
                                  --------
                             Component Library Code


                   Initial Revision  : Sun Mar 28 23:15:32 CST 1999
                   Revised : Sat Jul 15 1999

 ***************************************************************************/

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

unit Forms;

{$mode objfpc}{$H+}{$macro on}
{$I lcl_defines.inc}

interface

{$ifdef Trace}
  {$ASSERTIONS ON}
{$endif}

{$DEFINE HasDefaultValues}

uses
  // RTL + FCL
  Classes, SysUtils, Types, TypInfo, Math, CustApp, System.UITypes,
  // LCL
  LCLStrConsts, LCLType, LCLProc, LCLIntf, LCLVersion, LCLClasses, InterfaceBase,
  LResources, Graphics, Menus, LMessages, CustomTimer, ActnList,
  ClipBrd, HelpIntfs, Controls, ImgList, Themes,
  // LazUtils
  LazFileUtils, LazUTF8, Maps, IntegerList, LazMethodList, LazLoggerBase,
  Laztracer, LazUtilities, GraphType;

type
  TProcedure = procedure;
  TProcedureOfObject = procedure of object;

  // form position policies:
  TPosition = (
    poDesigned,        // use bounds from the designer (read from stream)
    poDefault,         // LCL decision (normally window manager decides)
    poDefaultPosOnly,  // designed size and LCL position
    poDefaultSizeOnly, // designed position and LCL size
    poScreenCenter,    // center form on screen (depends on DefaultMonitor)
    poDesktopCenter,   // center form on desktop (total of all screens)
    poMainFormCenter,  // center form on main form (depends on DefaultMonitor)
    poOwnerFormCenter, // center form on owner form (depends on DefaultMonitor)
    poWorkAreaCenter   // center form on working area (depends on DefaultMonitor)
    );

  TWindowState = (wsNormal, wsMinimized, wsMaximized, wsFullScreen);
  {$IF FPC_FULLVERSION >= 30300}
  TCloseAction = System.UITypes.TCloseAction;
  {$ELSE}
  TCloseAction = (caNone, caHide, caFree, caMinimize);
  {$ENDIF}

{$IF FPC_FULLVERSION >= 30300}
const
  caNone = System.UITypes.caNone;
  caHide = System.UITypes.caHide;
  caFree = System.UITypes.caFree;
  caMinimize = System.UITypes.caMinimize;
{$ENDIF}

type
  // forward class declarations
  TIDesigner = class;
  TMonitor = class;
  TScrollingWinControl = class;
  TCustomForm = class;

  { Hint actions }

  TCustomHintAction = class(TCustomAction)
  published
    property Hint;
  end;


  { TControlScrollBar }

  TScrollBarKind = (sbHorizontal, sbVertical);
  TScrollBarInc = 1..32768;
  TScrollBarStyle = (ssRegular, ssFlat, ssHotTrack);
  EScrollBar = class(Exception) end;

  TControlScrollBar = class(TPersistent)
  private
    FAutoRange: Longint; // = Max(0, FRange - ClientSize)
    FIncrement: TScrollBarInc;
    FKind: TScrollBarKind;
    FPage: TScrollBarInc;
    FRange: Integer; // if AutoScroll=true this is the needed size of the child controls
    FSmooth: Boolean;
    FTracking: Boolean;
    FVisible: Boolean;
    FOldScrollInfo: TScrollInfo;
    FOldVisible: Boolean;
    FOldScrollInfoValid: Boolean;
  protected
    FControl: TWinControl;
    FPosition: Integer;
    function ControlHandle: HWnd; virtual;
    function GetAutoScroll: Boolean; virtual;
    function GetIncrement: TScrollBarInc; virtual;
    function GetPage: TScrollBarInc; virtual;
    function GetPosition: Integer; virtual;
    function GetRange: Integer; virtual;
    function GetSize: Integer; virtual;
    function GetSmooth: Boolean; virtual;
    function HandleAllocated: Boolean; virtual;
    function IsRangeStored: Boolean; virtual;
    procedure ControlUpdateScrollBars; virtual;
    procedure InternalSetRange(const AValue: Integer); virtual;
    procedure ScrollHandler(var Message: TLMScroll);
    procedure SetIncrement(const AValue: TScrollBarInc); virtual;
    procedure SetPage(const AValue: TScrollBarInc); virtual;
    procedure SetPosition(const Value: Integer);
    procedure SetRange(const AValue: Integer); virtual;
    procedure SetSmooth(const AValue: Boolean); virtual;
    procedure SetTracking(const AValue: Boolean);
    procedure SetVisible(const AValue: Boolean); virtual;
    procedure UpdateScrollBar; virtual;
    procedure InvalidateScrollInfo;
  {$ifdef VerboseScrollingWinControl}
    function DebugCondition: Boolean;
  {$endif}
    function GetHorzScrollBar: TControlScrollBar; virtual;
    function GetVertScrollBar: TControlScrollBar; virtual;
  protected
    function ScrollBarShouldBeVisible: Boolean; virtual; // should the widget be made visible?
  public
    constructor Create(AControl: TWinControl; AKind: TScrollBarKind);
    procedure Assign(Source: TPersistent); override;
    function IsScrollBarVisible: Boolean; virtual; // returns current widget state
    function ScrollPos: Integer; virtual;
    property Kind: TScrollBarKind read FKind;
    function GetOtherScrollBar: TControlScrollBar;
    property Size: Integer read GetSize stored False;
    function ControlSize: Integer; // return for vertical scrollbar the control width
    function ClientSize: Integer; // return for vertical scrollbar the clientwidth
    function ClientSizeWithBar: Integer; // return for vertical scrollbar the clientwidth with the bar, even if Visible=false
    function ClientSizeWithoutBar: Integer; // return for vertical scrollbar the clientwidth without the bar, even if Visible=true
  published
    property Increment: TScrollBarInc read GetIncrement write SetIncrement default 8;
    property Page: TScrollBarInc read GetPage write SetPage default 80;
    property Smooth: Boolean read GetSmooth write SetSmooth default False;
    property Position: Integer read GetPosition write SetPosition default 0; // 0..Range-Page
    property Range: Integer read GetRange write SetRange stored IsRangeStored default 0; // >=Page
    property Tracking: Boolean read FTracking write SetTracking default False;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

  { TScrollingWinControl }

  TScrollingWinControl = class(TCustomControl)
  private
    FHorzScrollBar: TControlScrollBar;
    FVertScrollBar: TControlScrollBar;
    FAutoScroll: Boolean;
    FIsUpdating: Boolean;
    procedure SetHorzScrollBar(Value: TControlScrollBar);
    procedure SetVertScrollBar(Value: TControlScrollBar);
    procedure HideScrollbars;
  protected
    class procedure WSRegisterClass; override;
    procedure AlignControls(AControl: TControl; var ARect: TRect); override;
    function AutoScrollEnabled: Boolean; virtual;
    procedure CalculateAutoRanges; virtual;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    function GetClientScrollOffset: TPoint; override;
    function GetLogicalClientRect: TRect; override;// logical size of client area
    procedure DoOnResize; override;
    procedure GetPreferredSizeClientFrame(out aWidth, aHeight: Integer); override;
    procedure WMSize(var Message: TLMSize); message LM_Size;
    procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
    procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
    procedure ComputeScrollbars; virtual;
    procedure SetAutoScroll(Value: Boolean); virtual;
    procedure Loaded; override;
    procedure Resizing(State: TWindowState); virtual;
    property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default False;// auto show/hide scrollbars
    procedure SetAutoSize(Value: Boolean); override;
  public
    constructor Create(TheOwner : TComponent); override;
    destructor Destroy; override;
    function ScreenToClient(const APoint: TPoint): TPoint; override;
    function ClientToScreen(const APoint: TPoint): TPoint; override;
    procedure UpdateScrollbars;
    class function GetControlClassDefaultSize: TSize; override;
    procedure ScrollBy(DeltaX, DeltaY: Integer); override;
    procedure ScrollInView(AControl: TControl);
  published
    property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar;
    property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar;
  end;


  { TScrollBox }

  TScrollBox = class(TScrollingWinControl)
  protected
    class procedure WSRegisterClass; override;

    procedure SetParentBackground(const AParentBackground: Boolean); override;

    procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
    procedure Loaded; override;
    procedure UpdateParentColorChange;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Anchors;
    property AutoSize;
    property AutoScroll default True;
    property BorderSpacing;
    property BiDiMode;
    property BorderStyle default bsSingle;
    property ChildSizing;
    property ClientHeight;
    property ClientWidth;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;

    property DragMode;
    property Enabled;
    property Color nodefault;
    property Font;
    property ParentBackground default True;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    //property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnMouseWheelHorz;
    property OnMouseWheelLeft;
    property OnMouseWheelRight;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
    property OnPaint;
  end;

  TCustomDesignControl = class(TScrollingWinControl)
  private
    FScaled: Boolean;
    FDesignTimePPI: Integer;
    FPixelsPerInch: Integer;

    function DesignTimePPIIsStored: Boolean;
    procedure SetDesignTimePPI(const ADesignTimePPI: Integer);
  protected
    procedure SetScaled(const AScaled: Boolean); virtual;

    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
      const AXProportion, AYProportion: Double); override;
  public
    constructor Create(TheOwner: TComponent); override;

    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
      AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
  public
    property DesignTimePPI: Integer read FDesignTimePPI write SetDesignTimePPI stored DesignTimePPIIsStored;
    property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch stored False;
    property Scaled: Boolean read FScaled write SetScaled default True;
  end;


  { TCustomFrame }

  TCustomFrame = class(TCustomDesignControl)
  private
    procedure AddActionList(ActionList: TCustomActionList);
    procedure RemoveActionList(ActionList: TCustomActionList);
    procedure ReadDesignLeft(Reader: TReader);
    procedure ReadDesignTop(Reader: TReader);
    procedure WriteDesignLeft(Writer: TWriter);
    procedure WriteDesignTop(Writer: TWriter);
  protected
    class procedure WSRegisterClass; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetColor(Value: TColor); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure SetParentBackground(const AParentBackground: Boolean); override;
    procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
    procedure DefineProperties(Filer: TFiler); override;
    procedure CalculatePreferredSize(var PreferredWidth,
           PreferredHeight: Integer; WithThemeSpace: Boolean); override;
    procedure UpdateOpaque;
    procedure FixFrameFontsPPI(PPI: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    class function GetControlClassDefaultSize: TSize; override;

    property ParentBackground default True;
  end;

  TCustomFrameClass = class of TCustomFrame;


  { TFrame }

  TFrame = class(TCustomFrame)
  private
    FLCLVersion: string;
    function LCLVersionIsStored: Boolean;
  public
    constructor Create(TheOwner: TComponent); override;
  published
    property Align;
    property Anchors;
    property AutoScroll;
    property AutoSize;
    property BiDiMode;
    property BorderSpacing;
    property ChildSizing;
    property ClientHeight;
    property ClientWidth;
    property Color nodefault;
    property Constraints;
    property DesignTimePPI;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property LCLVersion: string read FLCLVersion write FLCLVersion stored LCLVersionIsStored;
    property ParentBackground;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Scaled;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnMouseWheelHorz;
    property OnMouseWheelLeft;
    property OnMouseWheelRight;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;


  { TWindowMagnetOptions }

  TWindowMagnetOptions = class(TPersistent)
  private
    FSnapMonitor: boolean;
    FSnapForms: boolean;
    FSnapFormTarget: boolean;
    FDistance: integer;
  public
    constructor Create;
    procedure AssignTo(Dest: TPersistent); override;
  published
    property SnapToMonitor: boolean read FSnapMonitor write FSnapMonitor default false;
    property SnapToForms: boolean read FSnapForms write FSnapForms default false;
    property SnapFormTarget: boolean read FSnapFormTarget write FSnapFormTarget default true;
    property Distance: integer read FDistance write FDistance default 10;
  end;

  { TWindowMagnetManager }

  TWindowMagnetManager = class
  private
    FEnabled: boolean;
    FActiveForm: TCustomForm;
    FPreviousSource, FPreviousReturn: TWindowPos;
    FCompositorBorders: TRect;
  protected
    function SnapToSides(var x, cx: integer; px, pcx, pxout, pcxout: integer; dist: integer; leftsides, rightsides: TIntegerDynArray): boolean;
    function SnapToMonitor(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean;
    function SnapToForms(Opts: TWindowMagnetOptions; var WindowPos: TWindowPos): boolean;
  public
    constructor Create;
    property Enabled: boolean read FEnabled write FEnabled;
    function SnapForm(Form: TCustomForm; var WindowPos: TWindowPos): boolean;
  end;


  { TCustomForm }

  TBorderIcon = ( // Form title bar items
    biSystemMenu, // system menu
    biMinimize,   // minimize button
    biMaximize,   // maximize button
    biHelp        // help button
  );
  TBorderIcons = set of TBorderIcon;

  TDefaultMonitor = ( // monitor to place form
    dmDesktop,        // use full desktop
    dmPrimary,        // use primary monitor
    dmMainForm,       // use monitor of main form
    dmActiveForm      // use monitor of active form
  );

  TFormStateType = (
    fsCreating,          // initializing (form streaming)
    fsVisible,           // form should be shown
    fsShowing,           // form handling WM_SHOWWINDOW message
    fsModal,             // form is modal
    fsCreatedMDIChild,   // todo: not mplemented
    fsBorderStyleChanged,// border style is changed before window handle creation
    fsFormStyleChanged,  // form style is changed before window handle creation
    fsFirstShow,         // form is shown for the first time
    fsDisableAutoSize    // disable autosize
    );
  TFormState = set of TFormStateType;

  TModalResult = System.UITypes.TModalResult;
  PModalResult = ^System.UITypes.TModalResult;

  TFormHandlerType = (
    fhtFirstShow,
    fhtClose,
    fhtCreate
    );

  TShowInTaskbar = (
    stDefault,  // use default rules for showing taskbar item
    stAlways,   // always show taskbar item for the form
    stNever     // never show taskbar item for the form
  );

  TPopupMode = (
    pmNone,     // modal: popup to active form or if not available, to main form; non-modal: no window parent
    pmAuto,     // modal & non-modal: popup to active form or if not available, to main form
    pmExplicit  // modal & non-modal: popup to PopupParent or if not available, to main form
  );

  TCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object;
  TCloseQueryEvent = procedure(Sender : TObject; var CanClose: Boolean) of object;
  TDropFilesEvent = procedure (Sender: TObject; const FileNames: array of string) of object;
  THelpEvent = function(Command: Word; Data: PtrInt; var CallHelp: Boolean): Boolean of object;
  TShortCutEvent = procedure (var Msg: TLMKey; var Handled: Boolean) of object;
  TModalDialogFinished = procedure (Sender: TObject; AResult: Integer) of object;


  TCustomForm = class(TCustomDesignControl)
  private
    FActive: Boolean;
    FActiveControl: TWinControl;
    FActiveDefaultControl: TControl;
    FAllowDropFiles: Boolean;
    FAlphaBlend: Boolean;
    FAlphaBlendValue: Byte;
    FBorderIcons: TBorderIcons;
    FDefaultControl: TControl;
    FCancelControl: TControl;
    FDefaultMonitor: TDefaultMonitor;
    FDesigner: TIDesigner;
    FFormStyle: TFormStyle;
    FFormUpdateCount: Integer;
    FFormHandlers: array[TFormHandlerType] of TMethodList;
    FHelpFile: string;
    FIcon: TIcon;
    FOnShowModalFinished: TModalDialogFinished;
    FPopupMode: TPopupMode;
    FPopupParent: TCustomForm;
    FSmallIconHandle: HICON;
    FBigIconHandle: HICON;
    FKeyPreview: Boolean;
    FMenu: TMainMenu;
    FModalResult: TModalResult;
    FLastActiveControl: TWinControl;
    FLastFocusedControl: TWinControl;
    FOldBorderStyle: TFormBorderStyle;
    FOnActivate: TNotifyEvent;
    FOnClose: TCloseEvent;
    FOnCloseQuery: TCloseQueryEvent;
    FOnCreate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    FOnDropFiles: TDropFilesEvent;
    FOnHelp: THelpEvent;
    FOnHide: TNotifyEvent;
    FOnShortcut: TShortCutEvent;
    FOnShow: TNotifyEvent;
    FOnWindowStateChange: TNotifyEvent;
    FPosition: TPosition;
    FRestoredLeft: Integer;
    FRestoredTop: Integer;
    FRestoredWidth: Integer;
    FRestoredHeight: Integer;
    FShowInTaskbar: TShowInTaskbar;
    FWindowState: TWindowState;
    FDelayedEventCtr: Integer;
    FDelayedOnChangeBounds, FDelayedOnResize: Boolean;
    FIsFirstOnShow, FIsFirstOnActivate: Boolean;
    FSnapOptions: TWindowMagnetOptions;
    function GetClientHandle: HWND;
    function GetEffectiveShowInTaskBar: TShowInTaskBar;
    function GetMonitor: TMonitor;
    function IsAutoScrollStored: Boolean;
    function IsForm: Boolean;
    function IsIconStored: Boolean;
    procedure CloseModal;
    procedure FreeIconHandles;
    procedure IconChanged(Sender: TObject);
    procedure DelayedEvent(Data: PtrInt);
    procedure SetActive(AValue: Boolean);
    procedure SetActiveControl(AWinControl: TWinControl);
    procedure SetActiveDefaultControl(AControl: TControl);
    procedure SetAllowDropFiles(const AValue: Boolean);
    procedure SetAlphaBlend(const AValue: Boolean);
    procedure SetAlphaBlendValue(const AValue: Byte);
    procedure SetBorderIcons(NewIcons: TBorderIcons);
    procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
    procedure SetCancelControl(NewControl: TControl);
    procedure SetDefaultControl(NewControl: TControl);
    procedure SetFormStyle(Value : TFormStyle);
    procedure SetIcon(AValue: TIcon);
    procedure SetMenu(Value: TMainMenu);
    procedure SetModalResult(Value: TModalResult);
    procedure SetPopupMode(const AValue: TPopupMode);
    procedure SetPopupParent(const AValue: TCustomForm);
    procedure SetPosition(Value: TPosition);
    procedure SetShowInTaskbar(Value: TShowInTaskbar);
    procedure SetLastFocusedControl(AControl: TWinControl);
    procedure SetWindowFocus;
    procedure SetWindowState(Value : TWindowState);
    procedure AddHandler(HandlerType: TFormHandlerType;
                         const Handler: TMethod; AsFirst: Boolean = false);
    procedure RemoveHandler(HandlerType: TFormHandlerType;
                            const Handler: TMethod);
    function FindDefaultForActiveControl: TWinControl;
    procedure UpdateMenu;
    procedure UpdateShowInTaskBar;
    function GetScreenSnap: boolean;
    procedure SetScreenSnap(aValue: boolean);
    function GetSnapBuffer: integer;
    procedure SetSnapBuffer(aValue: integer);
    procedure SetSnapOptions(aValue: TWindowMagnetOptions);
  protected
    procedure WMActivate(var Message : TLMActivate); message LM_ACTIVATE;
    procedure WMCloseQuery(var message: TLMessage); message LM_CLOSEQUERY;
    procedure WMHelp(var Message: TLMHelp); message LM_HELP;
    procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
    procedure WMSize(var message: TLMSize); message LM_Size;
    procedure WMWindowPosChanging(var Message: TLMWindowPosChanging); message LM_WINDOWPOSCHANGING;
    procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
    procedure CMAppShowBtnGlyphChanged(var Message: TLMessage); message CM_APPSHOWBTNGLYPHCHANGED;
    procedure CMAppShowMenuGlyphChanged(var Message: TLMessage); message CM_APPSHOWMENUGLYPHCHANGED;
    procedure CMIconChanged(var Message: TLMessage); message CM_ICONCHANGED;
    procedure CMRelease(var Message: TLMessage); message CM_RELEASE;
    procedure CMActivate(var Message: TLMessage); message CM_ACTIVATE;
    procedure CMDeactivate(var Message: TLMessage); message CM_DEACTIVATE;
    procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED;
    procedure WMDPIChanged(var Msg: TLMessage); message LM_DPICHANGED;
  protected
    FActionLists: TList; // keep this TList for Delphi compatibility
    FFormBorderStyle: TFormBorderStyle;
    FFormState: TFormState;
    class procedure WSRegisterClass; override;
    procedure DoShowWindow; virtual;
    procedure Activate; virtual;
    procedure ActiveChanged; virtual;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure BeginFormUpdate;
    function ColorIsStored: Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Deactivate; virtual;
    procedure DoClose(var CloseAction: TCloseAction); virtual;
    procedure DoCreate; virtual;
    procedure DoDestroy; virtual;
    procedure DoHide; virtual;
    procedure DoShow; virtual;
    procedure EndFormUpdate;
    function HandleCreateException: Boolean; virtual;
    function HandleDestroyException: Boolean; virtual;
    function HandleShowHideException: Boolean; virtual;
    procedure InitializeWnd; override;
    procedure Loaded; override;
    procedure ChildHandlesCreated; override;
    procedure Notification(AComponent: TComponent; Operation : TOperation);override;
    procedure PaintWindow(dc : Hdc); override;
    procedure RequestAlign; override;
    procedure Resizing(State: TWindowState); override;
    procedure CalculatePreferredSize(var PreferredWidth,
           PreferredHeight: Integer; WithThemeSpace: Boolean); override;
    procedure DoOnResize; override;
    procedure DoOnChangeBounds; override;
    procedure SetZOrder(Topmost: Boolean); override;
    procedure SetParent(NewParent: TWinControl); override;
    procedure MoveToDefaultPosition; virtual;
    procedure UpdateShowing; override;
    procedure SetVisible(Value: Boolean); override;
    procedure AllAutoSized; override;
    procedure DoFirstShow; virtual;
    procedure UpdateWindowState;
    procedure VisibleChanging; override;
    procedure VisibleChanged; override;
    procedure WndProc(var TheMessage : TLMessage); override;
    function VisibleIsStored: Boolean;
    procedure DoAutoSize; override;
    procedure SetAutoSize(Value: Boolean); override;
    procedure SetAutoScroll(Value: Boolean); override;
    procedure SetScaled(const AScaled: Boolean); override;
    procedure DoAddActionList(List: TCustomActionList);
    procedure DoRemoveActionList(List: TCustomActionList);
    procedure ProcessResource;virtual;
  protected
    // drag and dock
    procedure BeginAutoDrag; override;
    procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); override;
    function GetFloating: Boolean; override;
    function GetDefaultDockCaption: string; override;
  protected
    // actions
    procedure CMActionExecute(var Message: TLMessage); message CM_ACTIONEXECUTE;
    procedure CMActionUpdate(var Message: TLMessage); message CM_ACTIONUPDATE;
    function DoExecuteAction(ExeAction: TBasicAction): Boolean;
    function DoUpdateAction(TheAction: TBasicAction): Boolean;
    procedure UpdateActions; virtual;
  protected
    {MDI implementation}
    {returns handle of MDIForm client handle (container for mdi children this
    is not Handle of form itself !)}
    property ClientHandle: HWND read GetClientHandle;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    class function GetControlClassDefaultSize: TSize; override;

    function BigIconHandle: HICON;
    procedure Close;
    function CloseQuery: Boolean; virtual;
    procedure DefocusControl(Control: TWinControl; Removing: Boolean);
    procedure DestroyWnd; override;
    procedure EnsureVisible(AMoveToTop: Boolean = True);
    procedure FocusControl(WinControl: TWinControl);
    function FormIsUpdating: Boolean; override;
    procedure GetFormImage(ABitmap: TCustomBitmap);
    function GetFormImage: TBitmap;
    function GetRolesForControl(AControl: TControl): TControlRolesForForm;
    function GetRealPopupParent: TCustomForm;
    procedure Hide;
    procedure IntfDropFiles(const FileNames: array of string);
    procedure IntfHelp(AComponent: TComponent);
    function IsShortcut(var Message: TLMKey): Boolean; virtual;
    procedure MakeFullyVisible(AMonitor: TMonitor = nil; UseWorkarea: Boolean = True);
    function AutoSizeDelayedHandle: Boolean; override;
    procedure GetPreferredSize(var PreferredWidth, PreferredHeight: Integer;
                               Raw: Boolean = false;
                               WithThemeSpace: Boolean = true); override;
    procedure Release;
    function CanFocus: Boolean; override;
    procedure SetFocus; override;
    function SetFocusedControl(Control: TWinControl): Boolean ; virtual;
    procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: Integer; const
                                ADefaultPosition: Boolean = False);
    procedure Show;

    function ShowModal: Integer; virtual;
    procedure ShowOnTop;
    function SmallIconHandle: HICON;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function WantChildKey(Child : TControl;
                          var Message : TLMessage): Boolean; virtual;

    // handlers
    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
    procedure AddHandlerFirstShow(OnFirstShowHandler: TNotifyEvent;
                                  AsFirst: Boolean=false);
    procedure RemoveHandlerFirstShow(OnFirstShowHandler: TNotifyEvent);
    procedure AddHandlerClose(OnCloseHandler: TCloseEvent; AsFirst: Boolean=false);
    procedure RemoveHandlerClose(OnCloseHandler: TCloseEvent);
    procedure AddHandlerCreate(OnCreateHandler: TNotifyEvent; AsFirst: Boolean=false);
    procedure RemoveHandlerCreate(OnCreateHandler: TNotifyEvent);
  public
    {MDI implementation}
    function ActiveMDIChild: TCustomForm; virtual;
    function GetMDIChildren(AIndex: Integer): TCustomForm; virtual;
    function MDIChildCount: Integer; virtual;
  public
    procedure AutoScale; // set scaled to True and AutoAdjustLayout to current monitor PPI
  public
    // drag and dock
    procedure Dock(NewDockSite: TWinControl; ARect: TRect); override;
    procedure UpdateDockCaption(Exclude: TControl); override;
  public
    property Active: Boolean read FActive;
    property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
    property ActiveDefaultControl: TControl read FActiveDefaultControl write SetActiveDefaultControl;
    property AllowDropFiles: Boolean read FAllowDropFiles write SetAllowDropFiles default False;
    property AlphaBlend: Boolean read FAlphaBlend write SetAlphaBlend;
    property AlphaBlendValue: Byte read FAlphaBlendValue write SetAlphaBlendValue;
    property AutoScroll stored IsAutoScrollStored;
    property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons
      default [biSystemMenu, biMinimize, biMaximize];
    property BorderStyle: TFormBorderStyle
                      read FFormBorderStyle write SetFormBorderStyle default bsSizeable;
    property CancelControl: TControl read FCancelControl write SetCancelControl;
    property Caption stored IsForm;
    property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
    property DefaultControl: TControl read FDefaultControl write SetDefaultControl;
    property DefaultMonitor: TDefaultMonitor read FDefaultMonitor
      write FDefaultMonitor default dmActiveForm;
    property Designer: TIDesigner read FDesigner write FDesigner;
    property EffectiveShowInTaskBar: TShowInTaskBar read GetEffectiveShowInTaskBar;
    property FormState: TFormState read FFormState;
    property FormStyle: TFormStyle read FFormStyle write SetFormStyle
                                   default fsNormal;
    property HelpFile: string read FHelpFile write FHelpFile;
    property Icon: TIcon read FIcon write SetIcon stored IsIconStored;
    property KeyPreview: Boolean read FKeyPreview write FKeyPreview default False;
    property MDIChildren[I: Integer]: TCustomForm read GetMDIChildren;
    property Menu : TMainMenu read FMenu write SetMenu;
    property ModalResult : TModalResult read FModalResult write SetModalResult;
    property Monitor: TMonitor read GetMonitor;
    property LastActiveControl: TWinControl read FLastActiveControl;
    property PopupMode: TPopupMode read FPopupMode write SetPopupMode default pmNone;
    property PopupParent: TCustomForm read FPopupParent write SetPopupParent;
    property SnapOptions: TWindowMagnetOptions read FSnapOptions write SetSnapOptions;
    property ScreenSnap: boolean read GetScreenSnap write SetScreenSnap stored false;
    property SnapBuffer: integer read GetSnapBuffer write SetSnapBuffer stored false;

    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnClose: TCloseEvent read FOnClose write FOnClose stored IsForm;
    property OnCloseQuery : TCloseQueryEvent
                     read FOnCloseQuery write FOnCloseQuery stored IsForm;
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
    property OnHelp: THelpEvent read FOnHelp write FOnHelp;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnResize stored IsForm;
    property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnShowModalFinished: TModalDialogFinished read FOnShowModalFinished write FOnShowModalFinished;
    property OnWindowStateChange: TNotifyEvent
                         read FOnWindowStateChange write FOnWindowStateChange;
    property ParentFont default False;
    property Position: TPosition read FPosition write SetPosition default poDesigned;
    property RestoredLeft: Integer read FRestoredLeft;
    property RestoredTop: Integer read FRestoredTop;
    property RestoredWidth: Integer read FRestoredWidth;
    property RestoredHeight: Integer read FRestoredHeight;
    property ShowInTaskBar: TShowInTaskbar read FShowInTaskbar write SetShowInTaskBar
                                    default stDefault;
    property Visible stored VisibleIsStored default false;
    property WindowState: TWindowState read FWindowState write SetWindowState
                                       default wsNormal;
  end;

  TCustomFormClass = class of TCustomForm;


  { TForm }

  TForm = class(TCustomForm)
  private
    FLCLVersion: string;
    function LCLVersionIsStored: Boolean;
  protected
    class procedure WSRegisterClass; override;
    procedure CreateWnd; override;
    procedure Loaded; override;
  public
    constructor Create(TheOwner: TComponent); override;

    { mdi related routine}
    procedure Cascade;
    { mdi related routine}
    procedure Next;
    { mdi related routine}
    procedure Previous;
    { mdi related routine}
    procedure Tile;
    { mdi related routine}
    procedure ArrangeIcons;
    { mdi related property}
    property ClientHandle;

    property DockManager;
  published
    property Action;
    property ActiveControl;
    property Align;
    property AllowDropFiles;
    property AlphaBlend default False;
    property AlphaBlendValue default 255;
    property Anchors;
    property AutoScroll;
    property AutoSize;
    property BiDiMode;
    property BorderIcons;
    property BorderStyle;
    property BorderWidth;
    property Caption;
    property ChildSizing;
    property ClientHeight;
    property ClientWidth;
    property Color;
    property Constraints;
    property DefaultMonitor;
    property DesignTimePPI;
    property DockSite;
    property DoubleBuffered;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property FormStyle;
    property HelpFile;
    property Icon;
    property KeyPreview;
    property Menu;
    property ParentBiDiMode;
    property ParentDoubleBuffered;
    property ParentFont;
    property PixelsPerInch;
    property PopupMenu;
    property PopupMode;
    property PopupParent;
    property Position;
    property SessionProperties;
    property ScreenSnap;
    property ShowHint;
    property ShowInTaskBar;
    property SnapBuffer;
    property SnapOptions;
    property UseDockManager;
    property LCLVersion: string read FLCLVersion write FLCLVersion stored LCLVersionIsStored;
    property Scaled;
    property Visible;
    property WindowState;

    property OnActivate;
    property OnChangeBounds;
    property OnClick;
    property OnClose;
    property OnCloseQuery;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnCreate;
    property OnDblClick;
    property OnDeactivate;
    property OnDestroy;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDropFiles;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnHelp;
    property OnHide;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnMouseWheelHorz;
    property OnMouseWheelLeft;
    property OnMouseWheelRight;
    property OnPaint;
    property OnResize;
    property OnShortCut;
    property OnShow;
    property OnShowHint;
    property OnStartDock;
    property OnUnDock;
    property OnUTF8KeyPress;
    property OnWindowStateChange;
  end;

  TFormClass = class of TForm;


  { TCustomDockForm }

  TCustomDockForm = class(TCustomForm)
  protected
    procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
    procedure DoRemoveDockClient(Client: TControl); override;
    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
                          MousePos: TPoint; var CanDock: Boolean); override;
    procedure Loaded; override;
  public
    constructor Create(TheOwner: TComponent); override;
    property AutoScroll default False;
    property BorderStyle default bsSizeToolWin;
    property FormStyle default fsStayOnTop;
  published
    property PixelsPerInch;
  end;


  { THintWindow }

  THintWindow = class(TCustomForm)
  // For simple text hint without child controls.
  private
    FActivating: Boolean;
    FAlignment: TAlignment;
    FHintRect: TRect;
    FHintData: Pointer;
    FAutoHide: Boolean;
    FAutoHideTimer: TCustomTimer;
    FHideInterval: Integer;
    FHintCtrl: TControl;
    procedure AdjustBoundsForMonitor(KeepWidth: Boolean = True;
      KeepHeight: Boolean = True);
    function GetDrawTextFlags: Cardinal;
    procedure SetAutoHide(Value : Boolean);
    procedure AutoHideHint(Sender : TObject);
    procedure SetHideInterval(Value : Integer);
    procedure SetHintRectAdjust(AValue: TRect);
  protected
    class procedure WSRegisterClass; override;
    procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST;
    procedure ActivateSub; virtual;
    procedure DoShowWindow; override;
    procedure UpdateRegion; virtual;
    procedure SetColor(Value: TColor); override;
    function UseBGThemes: Boolean; virtual;
    function UseFGThemes: Boolean; virtual;
    procedure Paint; override;
  private class var
    FSysHintFont: TFont;
  protected
    class function SysHintFont: TFont; virtual;
  public
    class destructor Destroy;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateHint(const AHint: string);
    procedure ActivateHint(ARect: TRect; const AHint: string); virtual;
    procedure ActivateWithBounds(ARect: TRect; const AHint: string);
    procedure ActivateHintData(ARect: TRect; const AHint: string;
                               AData: pointer); virtual;
    function CalcHintRect(MaxWidth: Integer; const AHint: string;
                          AData: pointer): TRect; virtual;
    function OffsetHintRect(AOffset: TPoint; dy: Integer = 15;
      KeepWidth: Boolean = True; KeepHeight: Boolean = True): Boolean;
    procedure InitializeWnd; override;
    function IsHintMsg(Msg: TMsg): Boolean; virtual;
    procedure ReleaseHandle;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    class function GetControlClassDefaultSize: TSize; override;
  public
    property OnMouseDown;  // Public access may be needed.
    property OnMouseUp;
    property OnMouseMove;
    property OnMouseLeave;
    property Alignment: TAlignment read FAlignment write FAlignment;
    property HintRect: TRect read FHintRect write FHintRect;
    property HintRectAdjust: TRect read FHintRect write SetHintRectAdjust;
    property HintData: Pointer read FHintData write FHintData;
    property HintControl: TControl read FHintCtrl write FHintCtrl; experimental;
    property AutoHide: Boolean read FAutoHide write SetAutoHide;
    property BiDiMode;
    property HideInterval: Integer read FHideInterval write SetHideInterval;
  end;

  THintWindowClass = class of THintWindow;

  { THintWindowRendered }

  THintWindowRendered = class(THintWindow)
  // For rendered hint with a child control added by an external provider.
  private
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateRendered;
  end;

  { TMonitor }

  TMonitor = class(TObject)
  private
    FHandle: HMONITOR;
    FMonitorNum: Integer;
    function GetInfo(out Info: TMonitorInfo): Boolean; {inline; fpc bug - compilation error with inline}
    function GetLeft: Integer;
    function GetHeight: Integer;
    function GetPixelsPerInch: Integer;
    function GetTop: Integer;
    function GetWidth: Integer;
    function GetBoundsRect: TRect;
    function GetWorkareaRect: TRect;
    function GetPrimary: Boolean;
  public
    property Handle: HMONITOR read FHandle;
    property MonitorNum: Integer read FMonitorNum;
    property Left: Integer read GetLeft;
    property Height: Integer read GetHeight;
    property Top: Integer read GetTop;
    property Width: Integer read GetWidth;
    property BoundsRect: TRect read GetBoundsRect;
    property WorkareaRect: TRect read GetWorkareaRect;
    property Primary: Boolean read GetPrimary;
    property PixelsPerInch: Integer read GetPixelsPerInch;
  end;

  { TMonitorList }

  TMonitorList = class(TList)
  private
    function GetItem(AIndex: Integer): TMonitor;
    procedure SetItem(AIndex: Integer; const AValue: TMonitor);
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    property Items[AIndex: Integer]: TMonitor read GetItem write SetItem; default;
  end;

  { TScreen }

  PCursorRec = ^TCursorRec;
  TCursorRec = record
    Next: PCursorRec;
    Index: Integer;
    Handle: HCURSOR;
  end;

  TScreenFormEvent = procedure(Sender: TObject; Form: TCustomForm) of object;
  TScreenControlEvent = procedure(Sender: TObject;
                                  LastControl: TControl) of object;

  TScreenNotification = (
    snNewFormCreated,
    snFormAdded,
    snRemoveForm,
    snActiveControlChanged,
    snActiveFormChanged,
    snFormVisibleChanged
    );

  TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary);

  { TScreen }

  TScreen = class(TLCLComponent)
  private const
    crScreen = Low(TCursor); // use with Screen.BeginTempCursor/EndTempCursor to add Screen.Cursor into the temp list
  private
    FActiveControl: TWinControl;
    FActiveCustomForm: TCustomForm;
    FActiveForm: TForm;
    FCursor: TCursor;
    FTempCursors: array of TCursor;
    FCursorMap: TMap;
    FCustomForms: TFPList;
    FCustomFormsZOrdered: TFPList;
    FDefaultCursor: HCURSOR;
    FHintFont: TFont;
    FFocusedForm: TCustomForm;
    FFonts : TStringList;
    FFormList: TFPList;
    // A web server can create a DataModule per thread. The list must be thread safe.
    FDataModuleList: TThreadList;
    FIconFont: TFont;
    FMenuFont: TFont;
    FScreenHandlers: array[TScreenNotification] of TMethodList;
    FLastActiveControl: TWinControl;
    FLastActiveCustomForm: TCustomForm;
    FMonitors: TMonitorList;
    FOnActiveControlChange: TNotifyEvent;
    FOnActiveFormChange: TNotifyEvent;
    FPixelsPerInch : Integer;
    FSaveFocusedList: TFPList;
    FSystemFont: TFont;
    FMagnetManager: TWindowMagnetManager;
    procedure DeleteCursor(AIndex: Integer);
    procedure DestroyCursors;
    procedure DestroyMonitors;
    function GetCursors(AIndex: Integer): HCURSOR;
    function GetCustomFormCount: Integer;
    function GetCustomFormZOrderCount: Integer;
    function GetCustomForms(Index: Integer): TCustomForm;
    function GetCustomFormsZOrdered(Index: Integer): TCustomForm;
    function GetDataModuleCount: Integer;
    function GetDataModules(AIndex: Integer): TDataModule;
    function GetDesktopLeft: Integer;
    function GetDesktopTop: Integer;
    function GetDesktopHeight: Integer;
    function GetDesktopWidth: Integer;
    function GetDesktopRect: TRect;
    function GetFonts : TStrings;
    function GetFormCount: Integer;
    function GetForms(IIndex: Integer): TForm;
    function GetHeight : Integer;
    function GetMonitor(Index: Integer): TMonitor;
    function GetMonitorCount: Integer;
    function GetPrimaryMonitor: TMonitor;
    function GetRealCursor: TCursor;
    function GetWidth : Integer;
    procedure AddForm(AForm: TCustomForm);
    procedure RemoveForm(AForm: TCustomForm);
    function SetFocusedForm(AForm: TCustomForm): Boolean;
    procedure SetCursor(const AValue: TCursor);
    procedure SetCursors(AIndex: Integer; const AValue: HCURSOR);
    procedure SetHintFont(const AValue: TFont);
    procedure SetIconFont(const AValue: TFont);
    procedure SetMenuFont(const AValue: TFont);
    procedure SetSystemFont(const AValue: TFont);
    function UpdatedMonitor(AHandle: HMONITOR; ADefault: TMonitorDefaultTo;
      AErrorMsg: string): TMonitor;
    procedure UpdateLastActive;
    procedure RestoreLastActive;
    procedure AddHandler(HandlerType: TScreenNotification;
                         const Handler: TMethod; AsFirst: Boolean);
    procedure RemoveHandler(HandlerType: TScreenNotification;
                            const Handler: TMethod);
    procedure DoAddDataModule(DataModule: TDataModule);
    procedure DoRemoveDataModule(DataModule: TDataModule);
    procedure NotifyScreenFormHandler(HandlerType: TScreenNotification;
                                      Form: TCustomForm);
    function GetWorkAreaHeight: Integer;
    function GetWorkAreaLeft: Integer;
    function GetWorkAreaRect: TRect;
    function GetWorkAreaTop: Integer;
    function GetWorkAreaWidth: Integer;
  protected
    function GetHintFont: TFont; virtual;
    function GetIconFont: TFont; virtual;
    function GetMenuFont: TFont; virtual;
    function GetSystemFont: TFont; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    property MagnetManager: TWindowMagnetManager read FMagnetManager;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function CustomFormIndex(AForm: TCustomForm): Integer;
    function FormIndex(AForm: TForm): Integer;
    function CustomFormZIndex(AForm: TCustomForm): Integer;
    procedure MoveFormToFocusFront(ACustomForm: TCustomForm);
    procedure MoveFormToZFront(ACustomForm: TCustomForm);
    procedure NewFormWasCreated(AForm: TCustomForm);
    function GetCurrentModalForm: TCustomForm;
    function GetCurrentModalFormZIndex: Integer;
    function CustomFormBelongsToActiveGroup(AForm: TCustomForm): Boolean;
    function FindNonDesignerForm(const FormName: string): TCustomForm;
    function FindForm(const FormName: string): TCustomForm;
    function FindNonDesignerDataModule(const DataModuleName: string): TDataModule;
    function FindDataModule(const DataModuleName: string): TDataModule;
    procedure UpdateMonitors;
    procedure UpdateScreen;
    // handler
    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
    procedure AddHandlerNewFormCreated(OnNewFormCreated: TScreenFormEvent;
                                       AsFirst: Boolean=false);
    procedure RemoveHandlerNewFormCreated(OnNewFormCreated: TScreenFormEvent);
    procedure AddHandlerFormAdded(OnFormAdded: TScreenFormEvent;
                                  AsFirst: Boolean=false);
    procedure RemoveHandlerFormAdded(OnFormAdded: TScreenFormEvent);
    procedure AddHandlerRemoveForm(OnRemoveForm: TScreenFormEvent;
                                   AsFirst: Boolean=false);
    procedure RemoveHandlerRemoveForm(OnRemoveForm: TScreenFormEvent);
    procedure AddHandlerActiveControlChanged(
                                    OnActiveControlChanged: TScreenControlEvent;
                                    AsFirst: Boolean=false);
    procedure RemoveHandlerActiveControlChanged(
                                   OnActiveControlChanged: TScreenControlEvent);
    procedure AddHandlerActiveFormChanged(OnActiveFormChanged: TScreenFormEvent;
                                          AsFirst: Boolean=false);
    procedure RemoveHandlerActiveFormChanged(OnActiveFormChanged: TScreenFormEvent);
    procedure AddHandlerFormVisibleChanged(OnFormVisibleChanged: TScreenFormEvent;
                                           AsFirst: Boolean=false);
    procedure RemoveHandlerFormVisibleChanged(OnFormVisibleChanged: TScreenFormEvent);

    function DisableForms(SkipForm: TCustomForm; DisabledList: TList = nil): TList;
    procedure EnableForms(var AFormList: TList);
    function MonitorFromPoint(const Point: TPoint;
      MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
    function MonitorFromRect(const Rect: TRect;
      MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;
    function MonitorFromWindow(const Handle: TLCLHandle;
      MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor;

    procedure BeginTempCursor(const aCursor: TCursor);
    procedure EndTempCursor(const aCursor: TCursor);
    procedure BeginWaitCursor;
    procedure EndWaitCursor;
    procedure BeginScreenCursor;
    procedure EndScreenCursor;
  public
    property ActiveControl: TWinControl read FActiveControl;
    property ActiveCustomForm: TCustomForm read FActiveCustomForm;
    property ActiveForm: TForm read FActiveForm;
    property Cursor: TCursor read FCursor write SetCursor;
    property RealCursor: TCursor read GetRealCursor;
    property Cursors[Index: Integer]: HCURSOR read GetCursors write SetCursors;
    property CustomFormCount: Integer read GetCustomFormCount;
    property CustomForms[Index: Integer]: TCustomForm read GetCustomForms;
    property CustomFormZOrderCount: Integer read GetCustomFormZOrderCount;
    property CustomFormsZOrdered[Index: Integer]: TCustomForm
                               read GetCustomFormsZOrdered; // lower index means on top

    property DesktopLeft: Integer read GetDesktopLeft;
    property DesktopTop: Integer read GetDesktopTop;
    property DesktopHeight: Integer read GetDesktopHeight;
    property DesktopWidth: Integer read GetDesktopWidth;
    property DesktopRect: TRect read GetDesktopRect;

    property FocusedForm: TCustomForm read FFocusedForm;
    property FormCount: Integer read GetFormCount;
    property Forms[Index: Integer]: TForm read GetForms;
    property DataModuleCount: Integer read GetDataModuleCount;
    property DataModules[Index: Integer]: TDataModule read GetDataModules;
    
    property HintFont: TFont read GetHintFont write SetHintFont;
    property IconFont: TFont read GetIconFont write SetIconFont;
    property MenuFont: TFont read GetMenuFont write SetMenuFont;
    property SystemFont: TFont read GetSystemFont write SetSystemFont;
    property Fonts: TStrings read GetFonts;

    property Height: Integer read Getheight;
    property MonitorCount: Integer read GetMonitorCount;
    property Monitors[Index: Integer]: TMonitor read GetMonitor;
    property PixelsPerInch: Integer read FPixelsPerInch;
    property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
    property Width: Integer read GetWidth;
    property WorkAreaRect: TRect read GetWorkAreaRect;
    property WorkAreaHeight: Integer read GetWorkAreaHeight;
    property WorkAreaLeft: Integer read GetWorkAreaLeft;
    property WorkAreaTop: Integer read GetWorkAreaTop;
    property WorkAreaWidth: Integer read GetWorkAreaWidth;
    property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
                                                 write FOnActiveControlChange;
    property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
                                              write FOnActiveFormChange;
  end;


  { TApplication }

  TQueryEndSessionEvent = procedure (var Cancel: Boolean) of object;
  TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
  TGetHandleEvent = procedure(var Handle: HWND) of object;
  TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;
  TOnUserInputEvent = procedure(Sender: TObject; Msg: Cardinal) of object;
  TDataEvent = procedure (Data: PtrInt) of object;

  // application hint stuff
  TCMHintShow = record
    Msg: Cardinal;
  {$ifdef cpu64}
    UnusedMsg: Cardinal;
  {$endif}
    Reserved: WPARAM;
    HintInfo: PHintInfo;
    Result: LRESULT;
  end;

  TCMHintShowPause = record
    Msg: Cardinal;
  {$ifdef cpu64}
    UnusedMsg: Cardinal;
  {$endif}
    WasActive: PtrInt;
    Pause: PInteger;
    Result: LRESULT;
  end;

  TAppHintTimerType = (ahttNone, ahttShowHint, ahttHideHint, ahttReshowHint);

  TShowHintEvent = procedure (var HintStr: string; var CanShow: Boolean;
    var HintInfo: THintInfo) of object;

  THintInfoAtMouse = record
    MousePos: TPoint;
    Control: TControl;
    ControlHasHint: Boolean;
  end;

  TApplicationFlag = (
    AppWaiting,
    AppIdleEndSent,
    AppNoExceptionMessages,
    AppActive, // application has focus
    AppDestroying,
    AppDoNotCallAsyncQueue,
    AppInitialized // initialization of application was done
    );
  TApplicationFlags = set of TApplicationFlag;

  TApplicationNavigationOption = (
    anoTabToSelectNext,
    anoReturnForDefaultControl,
    anoEscapeForCancelControl,
    anoF1ForHelp,
    anoArrowToSelectNextInParent
    );
  TApplicationNavigationOptions = set of TApplicationNavigationOption;

  TApplicationHandlerType = (
    ahtIdle,
    ahtIdleEnd,
    ahtKeyDownBefore, // before interface and LCL
    ahtKeyDownAfter,  // after interface and LCL
    ahtActivate,
    ahtDeactivate,
    ahtUserInput,
    ahtException,
    ahtEndSession,
    ahtQueryEndSession,
    ahtMinimize,
    ahtModalBegin,
    ahtModalEnd,
    ahtRestore,
    ahtDropFiles,
    ahtHelp,
    ahtHint,
    ahtShowHint,
    ahtGetMainFormHandle,
    ahtActionExecute,
    ahtActionUpdate
    );

  PAsyncCallQueueItem = ^TAsyncCallQueueItem;
  TAsyncCallQueueItem = record
    Method: TDataEvent;
    Data: PtrInt;
    NextItem, PrevItem: PAsyncCallQueueItem;
  end;
  TAsyncCallQueue = record
    Top, Last: PAsyncCallQueueItem;
  end;
  TAsyncCallQueues = record
    CritSec: TRTLCriticalSection;
    Cur: TAsyncCallQueue; // currently processing
    Next: TAsyncCallQueue; // new calls added to this queue
  end;

  // This identifies the kind of device where the application currently runs on
  // Note that the same application can run in all kinds of devices if it has a
  // user interface flexible enough
  TApplicationType = (
    atDefault,     // The widgetset will attempt to auto-detect the device type
    atDesktop,     // For common desktops and notebooks
    atPDA,         // For smartphones and other devices with touch screen and a small screen
    atKeyPadDevice,// Devices without any pointing device, such as keypad feature phones or kiosk machines
    atTablet,      // Similar to a PDA/Smartphone, but with a large screen
    atTV,          // The device is a television
    atMobileEmulator// For desktop platforms. It will create a main windows of 240x320
                   // and place all forms there to immitate a mobile platform
  );

  TApplicationExceptionDlg = (
    aedOkCancelDialog,  // Exception handler window will be a dialog with Ok/Cancel buttons
    aedOkMessageBox     // Exception handler window will be a simple message box
  );

  TApplicationShowGlyphs = (
    sbgAlways,  // show them always (default)
    sbgNever,   // show them never
    sbgSystem   // show them depending on OS
  );

  TTaskBarBehavior = (
    tbDefault,      // widgetset dependent
    tbMultiButton,  // show buttons for Forms with ShowTaskBar = stDefault
    tbSingleButton  // hide buttons for Forms with ShowTaskBar = stDefault.
                    // Some Linux window managers do not support it. For example Cinnamon.
  );

  TApplicationDoubleBuffered = ( // what Forms.DoubleBuffered with ParentDoubleBuffered=True will gain when created
    adbDefault, // widgetset dependent (LCLWin32: True unless in remote desktop connection; other WSs: False)
    adbFalse,   // False
    adbTrue);   // True

  { TApplication }

  TApplication = class(TCustomApplication)
  private
    FApplicationHandlers: array[TApplicationHandlerType] of TMethodList;
    FApplicationType: TApplicationType;
    FCaptureExceptions: Boolean;
    FComponentsToRelease: TFPList;
    FComponentsReleasing: TFPList;
    FComponentsToReleaseSavedByModal: TFPList;
    FComponentsReleasingSavedByModal: TFPList;
    FCreatingForm: TForm;// currently created form (CreateForm), candidate for MainForm
    FDoubleBuffered: TApplicationDoubleBuffered;
    FExceptionDialog: TApplicationExceptionDlg;
    FExtendedKeysSupport: Boolean;
    FFindGlobalComponentEnabled: Boolean;
    FFlags: TApplicationFlags;
    FHint: string;
    FHintColor: TColor;
    FHintControl: TControl;
    FHintHidePause: Integer;
    FHintHidePausePerChar: Integer;
    FHintPause: Integer;
    FHintRect: TRect;
    FHintShortCuts: Boolean;
    FHintShortPause: Integer;
    FHintTimer: TCustomTimer;
    FHintTimerType: TAppHintTimerType;
    FHintWindow: THintWindow;
    FIcon: TIcon;
    FBigIconHandle: HICON;
    FLayoutAdjustmentPolicy: TLayoutAdjustmentPolicy;
    FMainFormOnTaskBar: Boolean;
    FModalLevel: Integer;
    FMoveFormFocusToChildren: Boolean;
    FOnCircularException: TExceptionEvent;
    FOnGetMainFormHandle: TGetHandleEvent;
    FOnMessageDialogFinished: TModalDialogFinished;
    FOnModalBegin: TNotifyEvent;
    FOnModalEnd: TNotifyEvent;
    FScaled: Boolean;
    FShowButtonGlyphs: TApplicationShowGlyphs;
    FShowMenuGlyphs: TApplicationShowGlyphs;
    FSmallIconHandle: HICON;
    FIdleLockCount: Integer;
    FLastKeyDownSender: TWinControl;
    FLastKeyDownKeys: TWordList;
    FLastKeyDownShift: TShiftState;
    FMainForm : TForm;
    FMouseControl: TControl;
    FNavigation: TApplicationNavigationOptions;
    FOldExceptProc: TExceptProc;
    FOnActionExecute: TActionEvent;
    FOnActionUpdate: TActionEvent;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    FOnDropFiles: TDropFilesEvent;
    FOnHelp: THelpEvent;
    FOnHint: TNotifyEvent;
    FOnIdle: TIdleEvent;
    FOnIdleEnd: TNotifyEvent;
    FOnEndSession: TNotifyEvent;
    FOnQueryEndSession: TQueryEndSessionEvent;
    FOnMinimize: TNotifyEvent;
    FOnRestore: TNotifyEvent;
    FOnShortcut: TShortcutEvent;
    FOnShowHint: TShowHintEvent;
    FOnUserInput: TOnUserInputEvent;
    FAsyncCall: TAsyncCallQueues;
    FShowHint: Boolean;
    FShowMainForm: Boolean;
    FLastMousePos: TPoint;
    FLastMouseControl: TControl;
    FLastMouseControlValid: Boolean;
    FBidiMode: TBiDiMode;
    FRestoreStayOnTop: TList;
    FTaskBarBehavior: TTaskBarBehavior;
    FUpdateFormatSettings: Boolean;
    FRemoveStayOnTopCounter: Integer;
    FExceptionCounter: Byte;
    procedure DoOnIdleEnd;
    function GetActive: Boolean;
    function GetActiveFormHandle: HWND;
    function GetCurrentHelpFile: string;
    function GetExename: string;
    function GetHandle: TLCLHandle;
    function GetMainFormHandle: HWND;
    function GetTitle: string;
    procedure FreeIconHandles;
    procedure IconChanged(Sender: TObject);
    procedure SetBidiMode(const AValue: TBiDiMode);
    procedure SetFlags(const AValue: TApplicationFlags);
    procedure SetMainFormOnTaskBar(const AValue: Boolean);
    procedure SetNavigation(const AValue: TApplicationNavigationOptions);
    procedure SetShowButtonGlyphs(const AValue: TApplicationShowGlyphs);
    procedure SetShowMenuGlyphs(const AValue: TApplicationShowGlyphs);
    procedure SetTaskBarBehavior(const AValue: TTaskBarBehavior);
    procedure UpdateMouseControl(NewMouseControl: TControl);
    procedure UpdateMouseHint(CurrentControl: TControl);
    procedure SetCaptureExceptions(const AValue: Boolean);
    procedure SetHandle(const AHandle: TLCLHandle);
    procedure SetHint(const AValue: string);
    procedure SetHintColor(const AValue: TColor);
    procedure SetIcon(AValue: TIcon);
    procedure SetShowHint(const AValue: Boolean);
    procedure StopHintTimer;
    function  ValidateHelpSystem: Boolean;
    procedure WndProc(var AMessage : TLMessage);
    function DispatchAction(Msg: Longint; Action: TBasicAction): Boolean;
    procedure AddHandler(HandlerType: TApplicationHandlerType;
                         const Handler: TMethod; AsFirst: Boolean);
    procedure RemoveHandler(HandlerType: TApplicationHandlerType;
                            const Handler: TMethod);
    procedure RunLoop;
    procedure Activate(Data: PtrInt);
    procedure Deactivate(Data: PtrInt);
  protected
    function GetConsoleApplication: Boolean; override;
    procedure NotifyIdleHandler(var Done: Boolean);
    procedure NotifyIdleEndHandler;
    procedure NotifyActivateHandler;
    procedure NotifyDeactivateHandler;
    procedure NotifyCustomForms(Msg: Word);
    function IsHintMsg(var Msg: TMsg): Boolean;
    function DoOnHelp(Command: Word; Data: PtrInt; var CallHelp: Boolean): Boolean; virtual;
    procedure DoOnMouseMove; virtual;
    procedure ShowHintWindow(const Info: THintInfoAtMouse);
    procedure OnHintTimer(Sender: TObject);
    procedure SetTitle(const AValue: string); override;
    procedure StartHintTimer(Interval: Integer; TimerType: TAppHintTimerType);
    procedure UpdateVisible;
    procedure DoIdleActions;
    procedure MenuPopupHandler(Sender: TObject);
    procedure ProcessAsyncCallQueue;
    procedure DoDecLCLRefcountToZero(Sender: TObject);
    procedure FreeComponent(Data: PtrInt);
    procedure ReleaseComponents;
    procedure DoBeforeFinalization;
    function GetParams(Index: Integer): string; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ActivateHint(CursorPos: TPoint; CheckHintControlChange: Boolean = False);
    function GetControlAtMouse: TControl;
    function GetControlAtPos(P: TPoint): TControl;
    procedure ControlDestroyed(AControl: TControl);
    function BigIconHandle: HIcon;
    function SmallIconHandle: HIcon;
    procedure BringToFront;
    procedure CreateForm(InstanceClass: TComponentClass; out Reference);
    procedure UpdateMainForm(AForm: TForm);
    procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
    procedure RemoveAsyncCalls(const AnObject: TObject);
    procedure ReleaseComponent(AComponent: TComponent);
    function ExecuteAction(ExeAction: TBasicAction): Boolean; override;
    function UpdateAction(TheAction: TBasicAction): Boolean; override;
    procedure HandleException(Sender: TObject); override;
    procedure HandleMessage;
    function HelpCommand(Command: Word; Data: PtrInt): Boolean;
    function HelpContext(Context: THelpContext): Boolean;
    function HelpKeyword(const Keyword: string): Boolean;
    function HelpShowTableOfContents: Boolean;
    procedure ShowHelpForObject(Sender: TObject);
    procedure RemoveStayOnTop(const ASystemTopAlso: Boolean = False);
    procedure RestoreStayOnTop(const ASystemTopAlso: Boolean = False);
    function IsWaiting: Boolean;
    procedure CancelHint;
    procedure HideHint;
    procedure HintMouseMessage(Control : TControl; var AMessage: TLMessage);
    procedure Initialize; override;
    function MessageBox(Text, Caption: PChar; Flags: Longint = MB_OK): Integer;
    procedure Minimize;
    procedure ModalStarted;
    procedure ModalFinished;
    procedure Restore;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ProcessMessages;
    procedure Idle(Wait: Boolean);
    procedure Run;
    procedure ShowException(E: Exception); override;
    procedure Terminate; override;
    procedure DisableIdleHandler;
    procedure EnableIdleHandler;
    procedure NotifyUserInputHandler(Sender: TObject; Msg: Cardinal);
    procedure NotifyKeyDownBeforeHandler(Sender: TObject;
                                         var Key: Word; Shift: TShiftState);
    procedure NotifyKeyDownHandler(Sender: TObject;
                                   var Key: Word; Shift: TShiftState);
    procedure ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ControlKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure AddOnIdleHandler(Handler: TIdleEvent; AsFirst: Boolean=true);
    procedure RemoveOnIdleHandler(Handler: TIdleEvent);
    procedure AddOnIdleEndHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnIdleEndHandler(Handler: TNotifyEvent);
    procedure AddOnUserInputHandler(Handler: TOnUserInputEvent;
                                    AsFirst: Boolean=true);
    procedure RemoveOnUserInputHandler(Handler: TOnUserInputEvent);
    procedure AddOnKeyDownBeforeHandler(Handler: TKeyEvent;
                                        AsFirst: Boolean=true);
    procedure RemoveOnKeyDownBeforeHandler(Handler: TKeyEvent);
    procedure AddOnKeyDownHandler(Handler: TKeyEvent; AsFirst: Boolean=true);
    procedure RemoveOnKeyDownHandler(Handler: TKeyEvent);
    procedure AddOnActivateHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnActivateHandler(Handler: TNotifyEvent);
    procedure AddOnDeactivateHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnDeactivateHandler(Handler: TNotifyEvent);
    procedure AddOnExceptionHandler(Handler: TExceptionEvent; AsFirst: Boolean=true);
    procedure RemoveOnExceptionHandler(Handler: TExceptionEvent);
    procedure AddOnEndSessionHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnEndSessionHandler(Handler: TNotifyEvent);
    procedure AddOnQueryEndSessionHandler(Handler: TQueryEndSessionEvent; AsFirst: Boolean=true);
    procedure RemoveOnQueryEndSessionHandler(Handler: TQueryEndSessionEvent);
    procedure AddOnMinimizeHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnMinimizeHandler(Handler: TNotifyEvent);
    procedure AddOnModalBeginHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnModalBeginHandler(Handler: TNotifyEvent);
    procedure AddOnModalEndHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnModalEndHandler(Handler: TNotifyEvent);
    procedure AddOnRestoreHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnRestoreHandler(Handler: TNotifyEvent);
    procedure AddOnDropFilesHandler(Handler: TDropFilesEvent; AsFirst: Boolean=true);
    procedure RemoveOnDropFilesHandler(Handler: TDropFilesEvent);
    procedure AddOnHelpHandler(Handler: THelpEvent; AsFirst: Boolean=true);
    procedure RemoveOnHelpHandler(Handler: THelpEvent);
    procedure AddOnHintHandler(Handler: TNotifyEvent; AsFirst: Boolean=true);
    procedure RemoveOnHintHandler(Handler: TNotifyEvent);
    procedure AddOnShowHintHandler(Handler: TShowHintEvent; AsFirst: Boolean=true);
    procedure RemoveOnShowHintHandler(Handler: TShowHintEvent);
    procedure AddOnGetMainFormHandleHandler(Handler: TGetHandleEvent; AsFirst: Boolean = True);
    procedure RemoveOnGetMainFormHandleHandler(Handler: TGetHandleEvent);
    procedure AddOnActionExecuteHandler(Handler: TActionEvent; AsFirst: Boolean = True);
    procedure RemoveOnActionExecuteHandler(Handler: TActionEvent);
    procedure AddOnActionUpdateHandler(Handler: TActionEvent; AsFirst: Boolean = True);
    procedure RemoveOnActionUpdateHandler(Handler: TActionEvent);

    procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual;
    procedure DoBeforeMouseMessage(CurMouseControl: TControl);
    function  IsShortcut(var Message: TLMKey): Boolean;
    procedure IntfQueryEndSession(var Cancel: Boolean);
    procedure IntfEndSession;
    procedure IntfAppActivate(const Async: Boolean = False);
    procedure IntfAppDeactivate(const Async: Boolean = False);
    procedure IntfAppMinimize;
    procedure IntfAppRestore;
    procedure IntfDropFiles(const FileNames: array of string);
    procedure IntfSettingsChange;
    procedure IntfThemeOptionChange(AThemeServices: TThemeServices; AOption: TThemeOption);

    function IsRightToLeft: Boolean;
    function IsRTLLang(const ALang: string): Boolean;
    function Direction(const ALang: string): TBiDiMode;
  public
    // on key down
    procedure DoArrowKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
    procedure DoTabKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
    // on key up
    procedure DoEscapeKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
    procedure DoReturnKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);

    property Active: Boolean read GetActive;
    property ActiveFormHandle: HWND read GetActiveFormHandle;
    property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
    property BidiMode: TBiDiMode read FBidiMode write SetBidiMode;
    property CaptureExceptions: Boolean read FCaptureExceptions
                                        write SetCaptureExceptions;
    property DoubleBuffered: TApplicationDoubleBuffered read FDoubleBuffered write FDoubleBuffered default adbDefault; platform;
    property ExtendedKeysSupport: Boolean read FExtendedKeysSupport write FExtendedKeysSupport; // See VK_LSHIFT in LCLType for more details
    property ExceptionDialog: TApplicationExceptionDlg read FExceptionDialog write FExceptionDialog;
    property FindGlobalComponentEnabled: Boolean read FFindGlobalComponentEnabled
                                               write FFindGlobalComponentEnabled;
    property Flags: TApplicationFlags read FFlags write SetFlags;
    //property HelpSystem : IHelpSystem read FHelpSystem;
    property Handle: TLCLHandle read GetHandle write SetHandle; platform;
    property Hint: string read FHint write SetHint;
    property HintColor: TColor read FHintColor write SetHintColor;
    property HintHidePause: Integer read FHintHidePause write FHintHidePause;
    property HintHidePausePerChar: Integer read FHintHidePausePerChar write FHintHidePausePerChar;
    property HintPause: Integer read FHintPause write FHintPause;
    property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts;
    property HintShortPause: Integer read FHintShortPause write FHintShortPause;
    property Icon: TIcon read FIcon write SetIcon;
    property LayoutAdjustmentPolicy: TLayoutAdjustmentPolicy read FLayoutAdjustmentPolicy write FLayoutAdjustmentPolicy;
    property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation;
    property MainForm: TForm read FMainForm;
    property MainFormHandle: HWND read GetMainFormHandle;
    property MainFormOnTaskBar: Boolean read FMainFormOnTaskBar write SetMainFormOnTaskBar; platform;
    property ModalLevel: Integer read FModalLevel;
    property MoveFormFocusToChildren: Boolean read FMoveFormFocusToChildren write FMoveFormFocusToChildren default True;
    property MouseControl: TControl read FMouseControl;
    property TaskBarBehavior: TTaskBarBehavior read FTaskBarBehavior write SetTaskBarBehavior;
    property UpdateFormatSettings: Boolean read FUpdateFormatSettings write FUpdateFormatSettings; platform;
    property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
    property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnGetMainFormHandle: TGetHandleEvent read FOnGetMainFormHandle write FOnGetMainFormHandle;
    property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
    property OnIdleEnd: TNotifyEvent read FOnIdleEnd write FOnIdleEnd;
    property OnEndSession: TNotifyEvent read FOnEndSession write FOnEndSession;
    property OnQueryEndSession: TQueryEndSessionEvent read FOnQueryEndSession write FOnQueryEndSession;
    property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
    property OnMessageDialogFinished: TModalDialogFinished read FOnMessageDialogFinished write FOnMessageDialogFinished;
    property OnModalBegin: TNotifyEvent read FOnModalBegin write FOnModalBegin;
    property OnModalEnd: TNotifyEvent read FOnModalEnd write FOnModalEnd;
    property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
    property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
    property OnHelp: THelpEvent read FOnHelp write FOnHelp;
    property OnHint: TNotifyEvent read FOnHint write FOnHint;
    property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut;
    property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
    property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnCircularException: TExceptionEvent read FOnCircularException write FOnCircularException;
    property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write SetShowButtonGlyphs default sbgAlways;
    property ShowMenuGlyphs: TApplicationShowGlyphs read FShowMenuGlyphs write SetShowMenuGlyphs default sbgAlways;
    property ShowHint: Boolean read FShowHint write SetShowHint;
    property ShowMainForm: Boolean read FShowMainForm write FShowMainForm default True;
    property Title: string read GetTitle write SetTitle;
    property Scaled: Boolean read FScaled write FScaled;
  end;

const
  DefaultApplicationBiDiMode: TBiDiMode = bdLeftToRight;

  DefHintColor = clInfoBk;           // default hint window color
  DefHintPause = 500;                // default pause before hint window displays (ms)
  DefHintShortPause = 0;             // default reshow pause
  DefHintHidePause = 5*DefHintPause; // default pause before hint is hidden (ms)
  DefHintHidePausePerChar = 200;     // added to DefHintHidePause (ms)

type
  { TApplicationProperties }

  TApplicationProperties = class(TLCLComponent)
  private
    FCaptureExceptions: Boolean;
    FExceptionDialogType: TApplicationExceptionDlg;
    FHelpFile: string;
    FHint: string;
    FHintColor: TColor;
    FHintHidePause: Integer;
    FHintPause: Integer;
    FHintShortCuts: Boolean;
    FHintShortPause: Integer;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnDropFiles: TDropFilesEvent;
    FOnGetMainFormHandle: TGetHandleEvent;
    FOnModalBegin: TNotifyEvent;
    FOnModalEnd: TNotifyEvent;
    FShowButtonGlyphs: TApplicationShowGlyphs;
    FShowHint: Boolean;
    FShowMainForm: Boolean;
    FShowMenuGlyphs: TApplicationShowGlyphs;
    FTitle: string;

    FOnException: TExceptionEvent;
    FOnIdle: TIdleEvent;
    FOnIdleEnd: TNotifyEvent;
    FOnHelp: THelpEvent;
    FOnHint: TNotifyEvent;
    FOnShowHint: TShowHintEvent;
    FOnUserInput: TOnUserInputEvent;
    FOnEndSession : TNotifyEvent;
    FOnQueryEndSession : TQueryEndSessionEvent;
    FOnMinimize : TNotifyEvent;
    FOnRestore : TNotifyEvent;
    FOnActionExecute: TActionEvent;
    FOnActionUpdate: TActionEvent;
    procedure SetExceptionDialog(AValue: TApplicationExceptionDlg);
  protected
    procedure SetCaptureExceptions(const AValue : Boolean);
    procedure SetHelpFile(const AValue : string);
    procedure SetHint(const AValue : string);
    procedure SetHintColor(const AValue : TColor);
    procedure SetHintHidePause(const AValue : Integer);
    procedure SetHintPause(const AValue : Integer);
    procedure SetHintShortCuts(const AValue : Boolean);
    procedure SetHintShortPause(const AValue : Integer);
    procedure SetShowButtonGlyphs(const AValue: TApplicationShowGlyphs);
    procedure SetShowMenuGlyphs(const AValue: TApplicationShowGlyphs);
    procedure SetShowHint(const AValue : Boolean);
    procedure SetShowMainForm(const AValue: Boolean);
    procedure SetTitle(const AValue : string);

    procedure SetOnActivate(AValue: TNotifyEvent);
    procedure SetOnDeactivate(AValue: TNotifyEvent);
    procedure SetOnException(const AValue : TExceptionEvent);
    procedure SetOnGetMainFormHandle(const AValue: TGetHandleEvent);
    procedure SetOnIdle(const AValue : TIdleEvent);
    procedure SetOnIdleEnd(const AValue : TNotifyEvent);
    procedure SetOnEndSession(const AValue : TNotifyEvent);
    procedure SetOnQueryEndSession(const AValue : TQueryEndSessionEvent);
    procedure SetOnMinimize(const AValue : TNotifyEvent);
    procedure SetOnModalBegin(const AValue: TNotifyEvent);
    procedure SetOnModalEnd(const AValue: TNotifyEvent);
    procedure SetOnRestore(const AValue : TNotifyEvent);
    procedure SetOnDropFiles(const AValue: TDropFilesEvent);
    procedure SetOnHelp(const AValue : THelpEvent);
    procedure SetOnHint(const AValue : TNotifyEvent);
    procedure SetOnShowHint(const AValue : TShowHintEvent);
    procedure SetOnUserInput(const AValue : TOnUserInputEvent);
    procedure SetOnActionExecute(const AValue : TActionEvent);
    procedure SetOnActionUpdate(const AValue : TActionEvent);
  public
    constructor Create(AOwner: TComponent); Override;
    destructor Destroy; override;
  published
    property CaptureExceptions: Boolean read FCaptureExceptions
                                        write SetCaptureExceptions default True;
    property ExceptionDialog: TApplicationExceptionDlg read FExceptionDialogType
                                                       write SetExceptionDialog default aedOkCancelDialog;
    property HelpFile: string read FHelpFile write SetHelpFile;
    property Hint: string read FHint write SetHint;
    property HintColor: TColor read FHintColor write SetHintColor default DefHintColor;
    property HintHidePause: Integer read FHintHidePause write SetHintHidePause default DefHintHidePause;
    property HintPause: Integer read FHintPause write SetHintPause default DefHintPause;
    property HintShortCuts: Boolean read FHintShortCuts write SetHintShortCuts default True;
    property HintShortPause: Integer read FHintShortPause write SetHintShortPause default DefHintShortPause;
    property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write SetShowButtonGlyphs default sbgAlways;
    property ShowMenuGlyphs: TApplicationShowGlyphs read FShowMenuGlyphs write SetShowMenuGlyphs default sbgAlways;
    property ShowHint: Boolean read FShowHint write SetShowHint default True;
    property ShowMainForm: Boolean read FShowMainForm write SetShowMainForm default True;
    property Title: string read FTitle write SetTitle;

    property OnActivate: TNotifyEvent read FOnActivate write SetOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write SetOnDeactivate;
    property OnException: TExceptionEvent read FOnException write SetOnException;
    property OnGetMainFormHandle: TGetHandleEvent read FOnGetMainFormHandle write SetOnGetMainFormHandle;
    property OnIdle: TIdleEvent read FOnIdle write SetOnIdle;
    property OnIdleEnd: TNotifyEvent read FOnIdleEnd write SetOnIdleEnd;
    property OnEndSession: TNotifyEvent read FOnEndSession write SetOnEndSession;
    property OnQueryEndSession: TQueryEndSessionEvent read FOnQueryEndSession write SetOnQueryEndSession;
    property OnMinimize: TNotifyEvent read FOnMinimize write SetOnMinimize;
    property OnModalBegin: TNotifyEvent read FOnModalBegin write SetOnModalBegin;
    property OnModalEnd: TNotifyEvent read FOnModalEnd write SetOnModalEnd;
    property OnRestore: TNotifyEvent read FOnRestore write SetOnRestore;
    property OnDropFiles: TDropFilesEvent read FOnDropFiles write SetOnDropFiles;
    property OnHelp: THelpEvent read FOnHelp write SetOnHelp;
    property OnHint: TNotifyEvent read FOnHint write SetOnHint;
    property OnShowHint: TShowHintEvent read FOnShowHint write SetOnShowHint;
    property OnUserInput: TOnUserInputEvent read FOnUserInput write SetOnUserInput;
    property OnActionExecute: TActionEvent read FOnActionExecute write SetOnActionExecute;
    property OnActionUpdate: TActionEvent read FOnActionUpdate write SetOnActionUpdate;
  end;


  { TIDesigner }

  TIDesigner = class(TObject)
  protected
    FLookupRoot: TComponent;
    FDefaultFormBoundsValid: Boolean;
  public
    function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
      virtual; abstract;
    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); virtual; abstract;
    procedure Modified; virtual; abstract;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); virtual; abstract;
    procedure PaintGrid; virtual; abstract;
    procedure ValidateRename(AComponent: TComponent;
      const CurName, NewName: string); virtual; abstract;
    function GetShiftState: TShiftState; virtual; abstract;
    procedure SelectOnlyThisComponent(AComponent: TComponent); virtual; abstract;
    function UniqueName(const BaseName: string): string; virtual; abstract;
    procedure PrepareFreeDesigner(AFreeComponent: Boolean); virtual; abstract;
  public
    property LookupRoot: TComponent read FLookupRoot;
    property DefaultFormBoundsValid: Boolean read FDefaultFormBoundsValid
                                             write FDefaultFormBoundsValid;
  end;


  { TFormPropertyStorage - abstract base class }

  TFormPropertyStorage = class(TControlPropertyStorage)
  private
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormDestroy(Sender : TObject);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

function KeysToShiftState(Keys: PtrUInt): TShiftState;
function KeyDataToShiftState(KeyData: PtrInt): TShiftState;
function KeyboardStateToShiftState: TShiftState;
function ShiftStateToKeys(ShiftState: TShiftState): PtrUInt;

function WindowStateToStr(const State: TWindowState): string;
function StrToWindowState(const Name: string): TWindowState;
function dbgs(const State: TWindowState): string; overload;
function dbgs(const Action: TCloseAction): string; overload;
function dbgs(const Kind: TScrollBarKind): string; overload;

type
  TFocusState = Pointer;

function SaveFocusState: TFocusState;
procedure RestoreFocusState(FocusState: TFocusState);

type
  TGetDesignerFormEvent = function(APersistent: TPersistent): TCustomForm of object;
  TIsFormDesignFunction = function(AForm: TWinControl): Boolean;

var
  OnGetDesignerForm: TGetDesignerFormEvent = nil;
  IsFormDesign: TIsFormDesignFunction = nil;

function GetParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
function GetDesignerForm(Control: TControl): TCustomForm;
function GetFirstParentForm(Control:TControl): TCustomForm;
function GetTopFormSkipNonDocked(Control: TControl): TCustomForm;
function ValidParentForm(Control: TControl; TopForm: Boolean = True): TCustomForm;
function GetDesignerForm(APersistent: TPersistent): TCustomForm;
function FindRootDesigner(APersistent: TPersistent): TIDesigner;
function GetParentDesignControl(Control: TControl): TCustomDesignControl;
function NeedParentDesignControl(Control: TControl): TCustomDesignControl;

function IsAccel(VK: word; const Str: string): Boolean;
procedure NotifyApplicationUserInput(Target: TControl; Msg: Cardinal);


function GetShortHint(const Hint: string): string;
function GetLongHint(const Hint: string): string;


var
  Application: TApplication = nil;
  Screen: TScreen = nil;
  ExceptionObject: TExceptObject;
  HintWindowClass: THintWindowClass = THintWindow;
  RequireDerivedFormResource: Boolean = False;

type
  TMessageBoxFunction = function(Text, Caption : PChar; Flags : Longint) : Integer;
var
  MessageBoxFunction: TMessageBoxFunction = nil;

const
  DefaultBorderIcons : array[TFormBorderStyle] of TBorderIcons =
    ([],                                        // bsNone
     [biSystemMenu, biMinimize],                // bsSingle
     [biSystemMenu, biMinimize, biMaximize],    // bsSizeable
     [biSystemMenu],                            // bsDialog
     [biSystemMenu, biMinimize],                // bsToolWindow
     [biSystemMenu, biMinimize, biMaximize]);   // bsSizeToolWin

procedure CreateWidgetset(AWidgetsetClass: TWidgetsetClass);
procedure FreeWidgetSet;

procedure Register;


implementation

{$R cursors.res}

{$ifdef WinCE}
  {$define extdecl := cdecl}
{$else}
  {$define extdecl := stdcall}
{$endif}

uses
  WSControls, WSForms; // Widgetset uses circle is allowed

var
  HandlingException: Boolean = False;
  HaltingProgram: Boolean = False;
  LastFocusedControl: TWinControl = nil;

procedure Register;
begin
  RegisterComponents('Standard',[TFrame]);
  RegisterComponents('Additional',[TScrollBox, TApplicationProperties]);
end;

{------------------------------------------------------------------------------
  procedure NotifyApplicationUserInput;

 ------------------------------------------------------------------------------}
procedure NotifyApplicationUserInput(Target: TControl; Msg: Cardinal);
begin
  if Assigned(Application) then
    Application.NotifyUserInputHandler(Target, Msg);
end;


//------------------------------------------------------------------------------
procedure ExceptionOccurred(Sender: TObject; Addr:Pointer; FrameCount: Longint;
  Frames: PPointer);
Begin
  DebugLn('[FORMS.PP] ExceptionOccurred ');
  if HaltingProgram or HandlingException then Halt;
  HandlingException:=true;
  if Sender<>nil then
  begin
    DebugLn('  Sender=',Sender.ClassName);
    if Sender is Exception then
    begin
      DebugLn('  Exception=',Exception(Sender).Message);
      DumpExceptionBackTrace();
    end;
  end else
    DebugLn('  Sender=nil');
  if Application<>nil then
    Application.HandleException(Sender);
  HandlingException:=false;
end;

procedure BeforeFinalization;
// This is our ExitProc handler.
begin
  Application.DoBeforeFinalization;
end;

function SaveFocusState: TFocusState;
begin
  Result := LastFocusedControl;
end;

procedure RestoreFocusState(FocusState: TFocusState);
begin
  LastFocusedControl := TWinControl(FocusState);
end;

//------------------------------------------------------------------------------
function KeysToShiftState(Keys: PtrUInt): TShiftState;
begin
  Result := [];
  if Keys and MK_Shift <> 0 then Include(Result, ssShift);
  if Keys and MK_Control <> 0 then Include(Result, ssCtrl);
  if Keys and MK_LButton <> 0 then Include(Result, ssLeft);
  if Keys and MK_RButton <> 0 then Include(Result, ssRight);
  if Keys and MK_MButton <> 0 then Include(Result, ssMiddle);
  if Keys and MK_XBUTTON1 <> 0 then Include(Result, ssExtra1);
  if Keys and MK_XBUTTON2 <> 0 then Include(Result, ssExtra2);
  if Keys and MK_DOUBLECLICK <> 0 then Include(Result, ssDouble);
  if Keys and MK_TRIPLECLICK <> 0 then Include(Result, ssTriple);
  if Keys and MK_QUADCLICK <> 0 then Include(Result, ssQuad);

  if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
end;

function KeyboardStateToShiftState: TShiftState;
begin
  Result := [];
  if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift);
  if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl);
  if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
  if (GetKeyState(VK_LWIN) < 0) or
     (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
end;

function KeyDataToShiftState(KeyData: PtrInt): TShiftState;
begin
  Result := MsgKeyDataToShiftState(KeyData);
end;

function ShiftStateToKeys(ShiftState: TShiftState): PtrUInt;
begin
  Result := 0;
  if ssShift  in ShiftState then Result := Result or MK_SHIFT;
  if ssCtrl   in ShiftState then Result := Result or MK_CONTROL;
  if ssLeft   in ShiftState then Result := Result or MK_LBUTTON;
  if ssRight  in ShiftState then Result := Result or MK_RBUTTON;
  if ssMiddle in ShiftState then Result := Result or MK_MBUTTON;
  if ssExtra1 in ShiftState then Result := Result or MK_XBUTTON1;
  if ssExtra2 in ShiftState then Result := Result or MK_XBUTTON2;
  if ssDouble in ShiftState then Result := Result or MK_DOUBLECLICK;
  if ssTriple in ShiftState then Result := Result or MK_TRIPLECLICK;
  if ssQuad   in ShiftState then Result := Result or MK_QUADCLICK;
end;

function WindowStateToStr(const State: TWindowState): string;
begin
  Result:=GetEnumName(TypeInfo(TWindowState),ord(State));
end;

function StrToWindowState(const Name: string): TWindowState;
begin
  Result:=TWindowState(GetEnumValueDef(TypeInfo(TWindowState),Name,
                                       ord(wsNormal)));
end;

function dbgs(const State: TWindowState): string; overload;
begin
  Result:=GetEnumName(TypeInfo(TWindowState),ord(State));
end;

function dbgs(const Action: TCloseAction): string; overload;
begin
  Result:=GetEnumName(TypeInfo(TCloseAction),ord(Action));
end;

function dbgs(const Kind: TScrollBarKind): string;
begin
  if Kind=sbVertical then
    Result:='sbVertical'
  else
    Result:='sbHorizontal';
end;

//------------------------------------------------------------------------------
function GetParentForm(Control: TControl; TopForm: Boolean): TCustomForm;
begin
  //For Delphi compatibility if Control is a TCustomForm with no parent, the function returns the TCustomForm itself
  while (Control <> nil) and (Control.Parent <> nil) do
  begin
    if (not TopForm) and (Control is TCustomForm) then
      Break;
    Control := Control.Parent;
  end;
  if Control is TCustomForm then
    Result := TCustomForm(Control)
  else
    Result := nil;
end;

//------------------------------------------------------------------------------
function GetParentDesignControl(Control: TControl): TCustomDesignControl;
begin
  while (Control <> nil) and (Control.Parent <> nil) do
    Control := Control.Parent;

  if Control is TCustomDesignControl then
    Result := TCustomDesignControl(Control)
  else
    Result := nil;
end;

//------------------------------------------------------------------------------
function NeedParentDesignControl(Control: TControl): TCustomDesignControl;
begin
  Result := GetParentDesignControl(Control);
  if Result=nil then
    raise EInvalidOperation.CreateFmt(rsControlHasNoParentFormOrFrame, [Control.Name]);
end;

//------------------------------------------------------------------------------
function GetDesignerForm(Control: TControl): TCustomForm;
begin
  // find the topmost parent form with designer

  Result := nil;
  while Control<>nil do
  begin
    if (Control is TCustomForm) and (TCustomForm(Control).Designer<>nil) then
      Result := TCustomForm(Control);
    Control := Control.Parent;
  end;
end;

function GetTopFormSkipNonDocked(Control: TControl): TCustomForm;
var
  aForm: TCustomForm;
begin
  Result:=GetParentForm(Control, False);
  if Result=nil then exit;
  if Result.DockSite or Result.UseDockManager then exit;
  repeat
    aForm:=GetParentForm(Result.Parent,false);
    if (aForm=nil) or aForm.DockSite or aForm.UseDockManager then exit;
    Result:=aForm;
  until false;
end;

//------------------------------------------------------------------------------
function ValidParentForm(Control: TControl; TopForm: Boolean): TCustomForm;
begin
  Result := GetParentForm(Control, TopForm);
  if Result = nil then
    raise EInvalidOperation.CreateFmt(sParentRequired, [Control.Name]);
end;


//------------------------------------------------------------------------------
function IsAccel(VK: word; const Str: string): Boolean;
const
  AmpersandChar = '&';
var
  position: Integer;
  ACaption, FoundChar: string;
begin
  ACaption := Str;
  Result := false;
  repeat
    position := UTF8Pos(AmpersandChar, ACaption);
    // Not found or found at the end of string. Nothing to underscore.
    if (position <= 0) or (position >= UTF8Length(ACaption)) then break;
    FoundChar := UTF8Copy(ACaption, position+1, 1);
    // two AmpersandChar characters together are not valid hot key
    if FoundChar = AmpersandChar then
      UTF8Delete(ACaption, 1, position+1)
    else
      Exit(UTF8UpperCase(UTF16ToUTF8(WideString(WideChar(VK)))) = UTF8UpperCase(FoundChar));
  until false;
end;

//==============================================================================

function FindRootDesigner(APersistent: TPersistent): TIDesigner;
var
  Form: TCustomForm;
begin
  Result:=nil;
  Form:=GetDesignerForm(APersistent);
  if Form<>nil then
    Result:=Form.Designer;
end;

function GetFirstParentForm(Control: TControl): TCustomForm;
begin
  if (Control = nil) then
    Result:= nil
  else
    Result := GetParentForm(Control, False);
end;

function GetDesignerForm(APersistent: TPersistent): TCustomForm;
begin
  if APersistent = nil then Exit(nil);
  if Assigned(OnGetDesignerForm) then
    Result := OnGetDesignerForm(APersistent)
  else
  begin
    Result := nil;
    repeat
      if (APersistent is TComponent) then begin
        if TComponent(APersistent).Owner=nil then
          exit;
        APersistent:=TComponent(APersistent).Owner;
      end else if APersistent is TCollection then begin
        if TCollection(APersistent).Owner=nil then
          exit;
        APersistent:=TCollection(APersistent).Owner;
      end else if APersistent is TCollectionItem then begin
        if TCollectionItem(APersistent).Collection=nil then
          exit;
        APersistent:=TCollectionItem(APersistent).Collection;
      end else if APersistent is TCustomForm then begin
        Result := TCustomForm(APersistent);
        exit;
      end else
        exit;
    until false;
  end;
end;

function SendApplicationMsg(Msg: Cardinal; WParam: WParam; LParam: LParam): Longint;
var
  AMessage: TLMessage;
begin
  if Application<>nil then begin
    AMessage.Msg := Msg;
    AMessage.WParam := WParam;
    AMessage.LParam := LParam;
    { Can't simply use SendMessage, as the Application does not necessarily have a handle }
    Application.WndProc(AMessage);
    Result := AMessage.Result;
  end else
    Result := 0;
end;

procedure IfOwnerIsFormThenDesignerModified(AComponent: TComponent);
begin
  if (AComponent<>nil) and (AComponent.Owner<>nil)
  and ([csDesigning,csLoading]*AComponent.ComponentState=[csDesigning])
  and (AComponent.Owner is TForm)
  and (TForm(AComponent.Owner).Designer <> nil) then
    TForm(AComponent.Owner).Designer.Modified;
end;

function GetShortHint(const Hint: string): string;
var
  I: Integer;
begin
  I := Pos('|', Hint);
  if I = 0 then
    Result := Hint else
    Result := Copy(Hint, 1, I - 1);
end;

function GetLongHint(const Hint: string): string;
var
  I: Integer;
begin
  I := Pos('|', Hint);
  if I = 0 then
    Result := Hint else
    Result := Copy(Hint, I + 1, Maxint);
end;

procedure CreateWidgetset(AWidgetsetClass: TWidgetsetClass);
begin
  //debugln('CreateWidgetset');
  CallInterfaceInitializationHandlers;
  WidgetSet := AWidgetsetClass.Create;
end;

procedure FreeWidgetSet;
begin
  //debugln('FreeWidgetSet');
  if Screen <> nil then
  begin
    Screen.DestroyCursors;
    Screen.DestroyMonitors;
  end;
  Application.Free;
  Application:=nil;
  CustomApplication:=nil;
  FreeAllClipBoards;
  CallInterfaceFinalizationHandlers;
  WidgetSet.Free;
  WidgetSet:=nil;
end;


//==============================================================================

{$I controlscrollbar.inc}
{$I scrollingwincontrol.inc}
{$I scrollbox.inc}
{$I customdesigncontrol.inc}
{$I customframe.inc}
{$I customform.inc}
{$I customdockform.inc}
{$I monitor.inc}
{$I screen.inc}
{$I application.inc}
{$I applicationproperties.inc}
{$I hintwindow.inc}
{$I windowmagnet.inc}


//==============================================================================

procedure ImageDrawEvent(AImageList: TPersistent; ACanvas: TPersistent;
                     AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect;
                     AImageWidth: Integer; ARefControl: TPersistent);
var
  ImageList: TCustomImageList absolute AImageList;
  Canvas: TCanvas absolute ACanvas;
  RefControl: TControl absolute ARefControl;
begin
  if (RefControl<>nil) and ImageList.Scaled then
    ImageList.DrawForControl(Canvas,AX,AY,AIndex,AImageWidth,RefControl,ADrawEffect)
  else
    ImageList.Draw(Canvas,AX,AY,AIndex,ADrawEffect)
end;

function IsFormDesignFunction(AForm: TWinControl): Boolean;
var
  LForm: TCustomForm absolute AForm;
begin
  if (AForm = nil) or not (AForm is TCustomForm) then
    Exit(False);
  Result := (csDesignInstance in LForm.ComponentState)
     or ((csDesigning in LForm.ComponentState) and (LForm.Designer <> nil));
end;

initialization
  LCLProc.OwnerFormDesignerModifiedProc:=@IfOwnerIsFormThenDesignerModified;
  ThemesImageDrawEvent:=@ImageDrawEvent;
  IsFormDesign:=@IsFormDesignFunction;
  Screen:=TScreen.Create(nil);
  Application:=TApplication.Create(nil);
  Assert(CustomApplication=Nil, 'CustomApplication is assigned in Forms initialization.');
  CustomApplication:=Application;

finalization
  //DebugLn('forms.pp - finalization section');
  LCLProc.OwnerFormDesignerModifiedProc:=nil;
  HintWindowClass:=nil;
  FreeThenNil(Application);
  CustomApplication:=nil;
  FreeThenNil(Screen);

end.
