{%MainUnit ../forms.pp}
{******************************************************************************
                                   TApplication
 ******************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{ $define DebugHintWindow}

function FindApplicationComponent(const ComponentName: string): TComponent;
begin
  if Application.FindGlobalComponentEnabled then
  begin
    Result:=Application.FindComponent(ComponentName);
    if Result=nil then
      Result:=Screen.FindForm(ComponentName);
    if Result=nil then
      Result:=Screen.FindDataModule(ComponentName);
  end
  else
    Result:=nil;
  //debugln('FindApplicationComponent ComponentName="',ComponentName,'" Result=',DbgSName(Result));
end;

function GetHintControl(Control: TControl): TControl;
begin
  Result := Control;
  while (Result <> nil) and (not Result.ShowHint) do
    Result := Result.Parent;
  if (Result <> nil)and
     ([csDesigning, csDestroying, csLoading] * Result.ComponentState <> []) then
    Result := nil;
end;

function GetHintInfoAtMouse: THintInfoAtMouse;
begin
  if Mouse <> nil then
  begin
    Result.MousePos := Mouse.CursorPos;
    Result.Control := GetHintControl(FindControlAtPosition(Result.MousePos, True));
    Result.ControlHasHint:=
      (Result.Control <> nil)
      and (Application <> nil) and (Application.ShowHint)
      and (GetCapture = 0)
      and ((GetKeyState(VK_LBUTTON) and $80) = 0)
      and ((GetKeyState(VK_MBUTTON) and $80) = 0)
      and ((GetKeyState(VK_RBUTTON) and $80) = 0);
    if Result.ControlHasHint then
    begin
      // if there is a modal form, then don't show hints for other forms
      if (Screen.FFocusedForm<>nil)
      and (fsModal in Screen.FFocusedForm.FormState)
      and (GetParentForm(Result.Control) <> Screen.FFocusedForm)
      then
        Result.ControlHasHint := False;
    end;
  end else
  begin
    Result.MousePos := Point(0, 0);
    Result.Control := nil;
    Result.ControlHasHint := False;
  end;
end;

// Callback function for SysUtils.OnGetApplicationName;
function GetApplicationName: string;
begin
  if Assigned(Application) then
    Result := Application.Title;
end;

{------------------------------------------------------------------------------
       TApplication Constructor
------------------------------------------------------------------------------}
constructor TApplication.Create(AOwner: TComponent);
const
  BidiModeMap: array[Boolean] of TBiDiMode = (bdLeftToRight, bdRightToLeft);

  function IsRTLLang(ALang: String): Boolean;
  begin
    Result := (ALang = 'ar') or
              (ALang = 'he');
  end;

var
  LangDefault, LangFallback: String;
begin
  LCLProc.SendApplicationMessageFunction:=@SendApplicationMsg;

  FShowButtonGlyphs := sbgAlways;
  FShowMenuGlyphs := sbgAlways;
  FMainForm := nil;
  FMouseControl := nil;
  FHintColor := DefHintColor;
  FHintPause := DefHintPause;
  FHintShortCuts := True;
  FHintShortPause := DefHintShortPause;
  FHintHidePause := DefHintHidePause;
  FHintHidePausePerChar := DefHintHidePausePerChar;
  FShowHint := true;
  FShowMainForm := true;
  FFormList := nil;
  FRestoreStayOnTop := nil;
  FOnIdle := nil;
  FIcon := TIcon.Create;
  FIcon.OnChange := @IconChanged;
  FNavigation := [anoTabToSelectNext,anoReturnForDefaultControl,
                  anoEscapeForCancelControl,anoF1ForHelp,anoArrowToSelectNextInParent];
  ApplicationActionComponent:=Self;
  OnMenuPopupHandler:=@MenuPopupHandler;

  FFindGlobalComponentEnabled:=true;
  RegisterFindGlobalComponentProc(@FindApplicationComponent);

  {$ifndef wince}// remove ifdef when gettext is fixed
  LCLGetLanguageIDs(LangDefault, LangFallback);
  if LangDefault <> '' then
    FBidiMode := BidiModeMap[IsRTLLang(LangDefault)]
  else
    FBidiMode := BidiModeMap[IsRTLLang(LangFallback)];
  {$else}
    FBidiMode := bdLeftToRight;
  {$endif}

  inherited Create(AOwner);
  CaptureExceptions:=true;

  FOldExitProc:=ExitProc;
  ExitProc:=@BeforeFinalization;
  
  OnGetApplicationName := @GetApplicationName;
end;

{------------------------------------------------------------------------------
       TApplication Destructor
------------------------------------------------------------------------------}
destructor TApplication.Destroy;
var
  HandlerType: TApplicationHandlerType;
begin
  if Self=nil then
    RaiseGDBException('TApplication.Destroy Self=nil');
  Include(FFlags,AppDestroying);

  if Assigned(FOnDestroy) then FOnDestroy(Self);

  ExitProc:=FOldExitProc;

  ProcessAsyncCallQueue;
  if OnMenuPopupHandler=@MenuPopupHandler then
    OnMenuPopupHandler:=nil;

  // shutting down
  CancelHint;
  ShowHint := False;

  // destroying
  ApplicationActionComponent:=nil;
  FreeThenNil(FIcon);
  FreeIconHandles;
  FreeThenNil(FFormList);
  FreeThenNil(FRestoreStayOnTop);

  for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType) do
    FreeThenNil(FApplicationHandlers[HandlerType]);

  UnregisterFindGlobalComponentProc(@FindApplicationComponent);

  inherited Destroy;

  Include(FFlags,AppDoNotCallAsyncQueue);
  ProcessAsyncCallQueue;

  // restore exception handling
  CaptureExceptions:=false;
  LCLProc.SendApplicationMessageFunction:=nil;
  OnGetApplicationName := nil;
end;

{------------------------------------------------------------------------------
       TApplication BringToFront
------------------------------------------------------------------------------}
procedure TApplication.BringToFront;
begin
  WidgetSet.AppBringToFront;
end;

{------------------------------------------------------------------------------
       TApplication Messagebox
------------------------------------------------------------------------------}
function TApplication.MessageBox(Text, Caption: PChar; Flags: Longint) : Integer;
begin
  if Assigned(MessageBoxFunction) then
    Result:=MessageBoxFunction(Text,Caption,Flags)
  else begin
    DebugLn('WARNING: TApplication.MessageBox: no MessageBoxFunction');
    DebugLn('  Caption="',Caption,'"');
    DebugLn('  Text="',Text,'"');
    DebugLn('  Flags=',DbgS(Flags));
    Result:=0;
  end;
end;

{------------------------------------------------------------------------------
       TApplication GetExename
------------------------------------------------------------------------------}
function TApplication.GetExeName: String;
Begin
  Result := ParamStrUTF8(0);
end;

{------------------------------------------------------------------------------
       TApplication Notification  "Performs Application Level Operations"
------------------------------------------------------------------------------}
procedure TApplication.Notification(AComponent : TComponent;
  Operation : TOperation);
begin
  if Operation = opRemove then begin
    FLastMouseControlValid:=false;
    if AComponent=FMouseControl then
      FMouseControl:=nil;
    if AComponent=FCreatingForm then
      FCreatingForm:=nil;
    if AComponent=FHintWindow then
      FHintWindow:=nil;
    if AComponent=FHintTimer then
      FHintTimer:=nil;
    if FComponentsToRelease<>nil then
      FComponentsToRelease.Remove(AComponent);
    if AComponent = MainForm then begin
      FMainForm:= nil;
      Terminate;
    end;
  end;
  inherited Notification(AComponent,Operation);
end;

{------------------------------------------------------------------------------
  Method: TApplication.ControlDestroyed
  Params: None
  Returns:  Nothing


 ------------------------------------------------------------------------------}
procedure TApplication.ControlDestroyed(AControl: TControl);
begin
  FLastMouseControlValid:=false;
  if AControl=FMouseControl then FMouseControl:=nil;
  if AControl = MainForm then FMainForm:= nil;
  if AControl = FCreatingForm then FCreatingForm:= nil;
  if Screen.FActiveControl = AControl then Screen.FActiveControl := nil;
  if Screen.FActiveCustomForm = AControl then
  begin
    Screen.FActiveCustomForm := nil;
    Screen.FActiveForm := nil;
  end;
  if Screen.FFocusedForm = AControl then Screen.FFocusedForm := nil;
  if FHintControl = AControl then FHintControl:=nil;
  Screen.UpdateLastActive;
end;

{------------------------------------------------------------------------------
  Method: TApplication.Minimize
  Params: None
  Returns: Nothing

  Minimizes the application.
 ------------------------------------------------------------------------------}
procedure TApplication.Minimize;
begin
  //debugln('TApplication.Minimize');
  WidgetSet.AppMinimize;
end;

{------------------------------------------------------------------------------
  Method: TApplication.Restore
  Params: None
  Returns: Nothing

  Restore minimized application.
 ------------------------------------------------------------------------------}
procedure TApplication.Restore;
begin
  //debugln('TApplication.Restore');
  WidgetSet.AppRestore;
end;

{------------------------------------------------------------------------------
  TApplication ProcesssMessages  "Enter the messageloop and process until empty"
------------------------------------------------------------------------------}
procedure TApplication.ProcessMessages;
begin
  WidgetSet.AppProcessMessages;
  ProcessAsyncCallQueue;
end;

{------------------------------------------------------------------------------
  Method: TApplication.Idle
  Params: Wait: wait till something happens
  Returns:  Nothing

  Invoked when the application enters the idle state
 ------------------------------------------------------------------------------}
procedure TApplication.Idle(Wait: boolean);
var
  Done: Boolean;
begin
  ReleaseComponents;
  ProcessAsyncCallQueue;
  UpdateMouseHint(GetControlAtMouse);

  Done := True;
  if (FIdleLockCount=0) then begin
    if Assigned(FOnIdle) then FOnIdle(Self, Done);
    if Done then
      NotifyIdleHandler(Done);
  end;
  if Done
  then begin
    // wait till something happens
    if (FIdleLockCount=0) then
      DoIdleActions;
    Include(FFlags,AppWaiting);
    Exclude(FFlags,AppIdleEndSent);
    if Wait then
      WidgetSet.AppWaitMessage;
    if (FIdleLockCount=0) then
      DoOnIdleEnd;
    Exclude(FFlags,AppWaiting);
  end;
end;

{------------------------------------------------------------------------------
  TApplication HintMouseMEssage
------------------------------------------------------------------------------}
procedure TApplication.HintMouseMessage(Control : TControl;
  var AMessage : TLMessage);
begin
  // ToDo
end;

{------------------------------------------------------------------------------
       TApplication Initialize
       Makes a call to the component engine to provide any initialization that
       needs to occur.
------------------------------------------------------------------------------}
procedure TApplication.Initialize;
begin
  inherited Initialize;
  // interface object and screen
  if (WidgetSet=nil) or (WidgetSet.ClassType = TWidgetSet)
  then begin
    DebugLn('ERROR: ',rsNoWidgetSet);
    raise Exception.Create(rsNoWidgetSet);
  end;
  WidgetSet.AppInit(ScreenInfo);
  ScreenInfo.Initialized := True;
  Screen.UpdateScreen;
  // set that we are initialized => all exceptions will be handled by our HandleException
  include(FFlags, AppInitialized);

  // application icon
  if LazarusResources.Find('MAINICON') <> nil then
    Icon.LoadFromLazarusResource('MAINICON');
end;

{------------------------------------------------------------------------------
  Method: TApplication.UpdateMouseHint
  Params: None
  Returns:  Nothing

  Handles mouse Idle
 ------------------------------------------------------------------------------}
procedure TApplication.UpdateMouseHint(CurrentControl: TControl);
var
  HintControl: TControl;
begin
  HintControl := GetHintControl(CurrentControl);
  if HintControl = nil then
    Hint := ''
  else
    Hint := GetLongHint(HintControl.Hint);
end;

procedure TApplication.SetCaptureExceptions(const AValue: boolean);
begin
  if FCaptureExceptions=AValue then exit;
  FCaptureExceptions:=AValue;
  if FCaptureExceptions then begin
    // capture exceptions
    // store old exceptproc
    if FOldExceptProc=nil then
      FOldExceptProc:=ExceptProc;
    ExceptProc:=@ExceptionOccurred;
  end else begin
    // do not capture exceptions
    if ExceptProc=@ExceptionOccurred then begin
      // restore old exceptproc
      ExceptProc:=FOldExceptProc;
      FOldExceptProc:=nil;
    end;
  end;
end;

function TApplication.HelpCommand(Command: Word; Data: PtrInt): Boolean;
var
  CallHelp: Boolean;
begin
  CallHelp := True;

  Result := DoOnHelp(Command, Data, CallHelp);

  if Result then
    Exit;

  if CallHelp then
  begin
    // TODO: call help
  end;
end;

{------------------------------------------------------------------------------
  function TApplication.GetControlAtMouse: TControl;

 ------------------------------------------------------------------------------}
function TApplication.GetControlAtMouse: TControl;
var
  P: TPoint;
begin
  GetCursorPos(P);
  //debugln(['TApplication.GetControlAtMouse p=',dbgs(p),' FLastMousePos=',dbgs(FLastMousePos)]);
  if FLastMouseControlValid and (P.X=FLastMousePos.x) and (P.Y=FLastMousePos.Y)
  then
    Result := FLastMouseControl
  else
    Result := FindControlAtPosition(P, True);
  
  if (Result <> nil) and (csDesigning in Result.ComponentState) then
    Result := nil;
  if Result<> nil then begin
    FLastMouseControlValid:=true;
    FLastMousePos:=p;
    FLastMouseControl:=Result;
  end;
end;

procedure TApplication.SetBidiMode ( const AValue : TBiDiMode ) ;
begin
  if AValue <> FBidiMode then
    FBidiMode := AValue;
end;

procedure TApplication.SetFlags(const AValue: TApplicationFlags);
begin
  { Only allow AppNoExceptionMessages to be changed }
  FFlags := Flags - [AppNoExceptionMessages] + AValue*[AppNoExceptionMessages];
end;

procedure TApplication.SetNavigation(const AValue: TApplicationNavigationOptions);
begin
  if FNavigation=AValue then exit;
  FNavigation:=AValue;
end;

procedure TApplication.SetShowButtonGlyphs(const AValue: TApplicationShowGlyphs);
begin
  if FShowButtonGlyphs = AValue then
    Exit;
  FShowButtonGlyphs := AValue;
  NotifyCustomForms(CM_APPSHOWBTNGLYPHCHANGED);
end;

procedure TApplication.SetShowMenuGlyphs(const AValue: TApplicationShowGlyphs);
begin
  if FShowMenuGlyphs = AValue then
    Exit;
  FShowMenuGlyphs := AValue;
  NotifyCustomForms(CM_APPSHOWMENUGLYPHCHANGED);
end;

{------------------------------------------------------------------------------
  procedure TApplication.UpdateMouseControl(NewMouseControl: TControl);

 ------------------------------------------------------------------------------}
procedure TApplication.UpdateMouseControl(NewMouseControl: TControl);
begin
  //debugln(['TApplication.UpdateMouseControl Old=',DbgSName(FMouseControl),' New=',DbgSName(NewMouseControl)]);
  if FMouseControl = NewMouseControl then
    Exit;
  if (FMouseControl <> nil) then
  begin
    //DebugLn' MOUSELEAVE=',FMouseControl.Name,':',FMouseControl.ClassName);
    FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);
  end;
  FMouseControl := NewMouseControl;

  Application.UpdateMouseHint(FMouseControl);

  if (FMouseControl <> nil) then
  begin
    //DebugLn' MOUSEENTER=',FMouseControl.Name,':',FMouseControl.ClassName);
    FMouseControl.Perform(CM_MOUSEENTER, 0, 0);
  end;
end;

{------------------------------------------------------------------------------
  Method: TApplication.SetIcon
  Params: the new icon
 ------------------------------------------------------------------------------}
procedure TApplication.SetIcon(AValue: TIcon);
begin
  FIcon.Assign(AValue);
end;

{------------------------------------------------------------------------------
  procedure TApplication.SetShowHint(const AValue: Boolean);
 ------------------------------------------------------------------------------}
procedure TApplication.SetShowHint(const AValue: Boolean);
begin
  if FShowHint = AValue then
    exit;
  FShowHint := AValue;
  if FShowHint then
  begin
    //
  end else
  begin
    FreeThenNil(FHintWindow);
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.SetTitle(const AValue: String);
 ------------------------------------------------------------------------------}
procedure TApplication.SetTitle(const AValue: String);
begin
  inherited SetTitle(AValue);
  WidgetSet.AppSetTitle(GetTitle);
end;

{------------------------------------------------------------------------------
  procedure TApplication.StopHintTimer;
 ------------------------------------------------------------------------------}
procedure TApplication.StopHintTimer;
begin
  if FHintTimer <> nil then
    FHintTimer.Enabled := False;
end;

{------------------------------------------------------------------------------
  procedure TApplication.ValidateHelpSystem;
 ------------------------------------------------------------------------------}
function TApplication.ValidateHelpSystem: Boolean;
begin
  Result := HelpManager <> nil;
end;

{------------------------------------------------------------------------------
  procedure TApplication.NotifyIdleHandler(var Done: Boolean);
  
  Done = true will wait for the next message
  Done = false will repeat calling the OnIdle handlers
 ------------------------------------------------------------------------------}
procedure TApplication.NotifyIdleHandler(var Done: Boolean);
var
  i: LongInt;
begin
  i:=FApplicationHandlers[ahtIdle].Count;
  while FApplicationHandlers[ahtIdle].NextDownIndex(i) do begin
    TIdleEvent(FApplicationHandlers[ahtIdle][i])(Self,Done);
    if not Done then exit;
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.NotifyIdleEndHandler;

 ------------------------------------------------------------------------------}
procedure TApplication.NotifyIdleEndHandler;
begin
  FApplicationHandlers[ahtIdleEnd].CallNotifyEvents(Self);
end;

procedure TApplication.NotifyActivateHandler;
begin
  if Assigned(OnActivate) then OnActivate(Self);
  FApplicationHandlers[ahtActivate].CallNotifyEvents(Self);
end;

procedure TApplication.NotifyDeactivateHandler;
begin
  if Assigned(OnDeactivate) then OnDeactivate(Self);
  FApplicationHandlers[ahtDeactivate].CallNotifyEvents(Self);
end;

procedure TApplication.NotifyCustomForms(Msg: Word);
var
  i: integer;
begin
  for i := 0 to Screen.CustomFormCount - 1 do
    Screen.CustomForms[i].Perform(Msg, 0, 0);
end;

{------------------------------------------------------------------------------
  function TApplication.IsHintMsg(var Msg: TMsg): Boolean;

 ------------------------------------------------------------------------------}
function TApplication.IsHintMsg(var Msg: TMsg): Boolean;
begin
  Result := False;
end;

function TApplication.DoOnHelp(Command: Word; Data: PtrInt; var CallHelp: Boolean): Boolean;
var
  ActiveForm: TCustomForm;
  i: LongInt;
begin
  ActiveForm := Screen.ActiveCustomForm;

  if Assigned(ActiveForm) and Assigned(ActiveForm.FOnHelp) then
    Result := ActiveForm.FOnHelp(Command, Data, CallHelp)
  else
  begin
    if Assigned(FOnHelp) then
      Result := FOnHelp(Command, Data, CallHelp)
    else
      Result := False;
    i := FApplicationHandlers[ahtHelp].Count;
    while not Result and FApplicationHandlers[ahtHelp].NextDownIndex(i) do
      Result := THelpEvent(FApplicationHandlers[ahtHelp][i])(Command, Data, CallHelp);
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.DoOnMouseMove;

 ------------------------------------------------------------------------------}
procedure TApplication.DoOnMouseMove;
var
  Info: THintInfoAtMouse;
  HintControlChanged: Boolean;
begin
  Info := GetHintInfoAtMouse;

  {$ifdef DebugHintWindow}
    DebugLn('TApplication.DoOnMouseMove Info.ControlHasHint=',dbgs(Info.ControlHasHint),' Type=',dbgs(ord(FHintTimerType)),' FHintControl=',DbgSName(FHintControl),' Info.Control=',DbgSName(Info.Control));
  {$endif}
  HintControlChanged := FHintControl <> Info.Control;
  if Info.ControlHasHint then
  begin
    if HintControlChanged then
    begin
      StopHintTimer;
      HideHint;
      FHintControl := Info.Control;
      FHintRect := FHintControl.BoundsRect;
    end;
    case FHintTimerType of
      ahttNone, ahttHideHint:
        //react only if the hint control changed or if the mouse leave the previously set hint rect
        if HintControlChanged or (not PtInRect(FHintRect, FHintControl.ScreenToClient(Info.MousePos))) then
        begin
          //if a hint is visible immediately query the app to show a new hint...
          if FHintTimerType = ahttHideHint then
            ShowHintWindow(Info);
          //...if there's no hint window visible at this point than schedule a new query
          if (FHintTimerType = ahttNone) or (FHintWindow = nil) or not FHintWindow.Visible then
            StartHintTimer(HintPause, ahttShowHint);
        end;
      ahttShowHint:
        StartHintTimer(HintPause, ahttShowHint);
    end;
  end
  else
    CancelHint;
end;

{------------------------------------------------------------------------------
  procedure TApplication.ShowHintWindow(const Info: THintInfoAtMouse);
 ------------------------------------------------------------------------------}
procedure TApplication.ShowHintWindow(const Info: THintInfoAtMouse);

  function GetCursorHeightMargin: integer;
  begin
    Result:=25;
  end;

var
  ClientOrigin, ParentOrigin: TPoint;
  HintInfo: THintInfo;
  CanShow: Boolean;
  HintWinRect: TRect;
  CurHeight: Integer;
  i: LongInt;
begin
  if not FShowHint or (FHintControl=nil) then
    Exit;

  {$ifdef DebugHintWindow}
    debugln('TApplication.ShowHintWindow A OldHint="',Hint,'" NewHint="',GetShortHint(Info.Control.Hint),'"');
  {$endif}
  
  CurHeight:=GetCursorHeightMargin;
  HintInfo.HintControl := FHintControl;
  HintInfo.HintPos := Info.MousePos;

  // to reduce flicker
  HintInfo.HintPos.X:=HintInfo.HintPos.X and (not $F);
  HintInfo.HintPos.Y:=HintInfo.HintPos.Y and (not $F);

  Inc(HintInfo.HintPos.Y, CurHeight);
  HintInfo.HintMaxWidth := Screen.Width;
  HintInfo.HintColor := FHintColor;
  HintInfo.CursorRect := FHintControl.BoundsRect;
  ClientOrigin := FHintControl.ClientOrigin;
  ParentOrigin.X := 0;
  ParentOrigin.Y := 0;
  if FHintControl.Parent <> nil then
    ParentOrigin := FHintControl.Parent.ClientOrigin;
  OffsetRect(HintInfo.CursorRect, ParentOrigin.X - ClientOrigin.X,
    ParentOrigin.Y - ClientOrigin.Y);
  HintInfo.CursorPos := FHintControl.ScreenToClient(Info.MousePos);
  HintInfo.HintStr := GetShortHint(Info.Control.Hint);
  HintInfo.ReshowTimeout := 0;
  HintInfo.HideTimeout := FHintHidePause
                          +FHintHidePausePerChar*length(HintInfo.HintStr);
  HintInfo.HintWindowClass := HintWindowClass;
  HintInfo.HintData := nil;
  CanShow := FHintControl.Perform(CM_HINTSHOW, 0, LParam(PtrUInt(@HintInfo))) = 0;
  if (HintInfo.HintWindowClass=nil)
  or (not HintInfo.HintWindowClass.InheritsFrom(THintWindow)) then
    HintInfo.HintWindowClass := HintWindowClass;

  i:=FApplicationHandlers[ahtShowHint].Count;
  if CanShow and (i>0) then begin
    if Assigned(FOnShowHint) then
      FOnShowHint(HintInfo.HintStr, CanShow, HintInfo);
    while FApplicationHandlers[ahtShowHint].NextDownIndex(i) do
      TShowHintEvent(FApplicationHandlers[ahtShowHint][i])(HintInfo.HintStr, CanShow, HintInfo);
  end;
  if CanShow and (FHintControl <> nil) and (HintInfo.HintStr <> '') then
  begin
    // create hint window
    if (FHintWindow<>nil) and (FHintWindow.ClassType<>HintInfo.HintWindowClass)
    then
      FreeThenNil(FHintWindow);
    if FHintWindow=nil then
    begin
      FHintWindow:=THintWindowClass(HintInfo.HintWindowClass).Create(Self);
      with FHintWindow do
      begin
        Visible := False;
        Caption := '';
        AutoHide := False;
      end;
    end;

    // make the hint have the same BiDiMode as the activating control
    //FHintWindow.BiDiMode := FHintControl.BiDiMode;
    // calculate the width of the hint based on HintStr and MaxWidth
    with HintInfo do
      HintWinRect := FHintWindow.CalcHintRect(HintMaxWidth, HintStr, HintData);
    OffsetRect(HintWinRect, HintInfo.HintPos.X, HintInfo.HintPos.Y);
    //DebugLn(['TApplication.ShowHintWindow HintStr="',HintInfo.HintStr,'" HintWinRect=',dbgs(HintWinRect)]);
    {if FHintWindow.UseRightToLeftAlignment then
      with HintWinRect do
      begin
        Dec(Left, FHintWindow.Canvas.TextWidth(HintInfo.HintStr) + 5);
        Dec(Right, FHintWindow.Canvas.TextWidth(HintInfo.HintStr) + 5);
      end;}

    // Convert the client's rect to screen coordinates
    {with HintInfo do
    begin
      FHintCursorRect.TopLeft :=
        FHintControl.ClientToScreen(CursorRect.TopLeft);
      FHintCursorRect.BottomRight :=
        FHintControl.ClientToScreen(CursorRect.BottomRight);
    end;}

    FHintWindow.Color := HintInfo.HintColor;
    //DebugLn(['TApplication.ShowHintWindow FHintWindow.Color=',dbgs(FHintWindow.Color),' HintInfo.HintColor=',dbgs(HintInfo.HintColor)]);

    //debugln('TApplication.ShowHintWindow B HintWinRect=',dbgs(HintWinRect),' HintStr="',DbgStr(HintInfo.HintStr),'"');
    FHintWindow.ActivateHint(HintWinRect,HintInfo.HintStr);
    FHintRect := HintInfo.CursorRect;
    // start hide timer
    StartHintTimer(HintInfo.HideTimeout,ahttHideHint);
  end
  else
    HideHint;

  {$ifdef DebugHintWindow}
    DebugLn(['TApplication.ShowHintWindow Info.ControlHasHint=',
      Info.ControlHasHint, ' Type=', ord(FHintTimerType)]);
  {$endif}
end;

{------------------------------------------------------------------------------
  procedure TApplication.StartHintTimer(Interval: integer;
    TimerType: TAppHintTimerType);
 ------------------------------------------------------------------------------}
procedure TApplication.StartHintTimer(Interval: integer;
  TimerType: TAppHintTimerType);
begin
  {$ifdef DebugHintWindow}
    debugln('TApplication.StartHintTimer ',dbgs(Interval));
  {$endif}
  StopHintTimer;
  FHintTimerType := TimerType;
  if Interval > 0 then
  begin
    if FHintTimer = nil then
      FHintTimer := TCustomTimer.Create(Self);
    FHintTimer.Interval := Interval;
    FHintTimer.OnTimer := @OnHintTimer;
    FHintTimer.Enabled := True;
  end
  else
    OnHintTimer(Self);
end;

{------------------------------------------------------------------------------
  procedure TApplication.OnHintTimer(Sender: TObject);
 ------------------------------------------------------------------------------}
procedure TApplication.OnHintTimer(Sender: TObject);
var
  Info: THintInfoAtMouse;
begin
  {$ifdef DebugHintWindow}
    DebugLn('TApplication.OnHintTimer Type=', IntToStr(ord(FHintTimerType)));
  {$endif}
  StopHintTimer;
  case FHintTimerType of
    ahttShowHint:
      begin
        Info := GetHintInfoAtMouse;
        if Info.ControlHasHint then
          ShowHintWindow(Info)
        else
          HideHint;
      end;
    ahttHideHint:
      begin
        HideHint;
        FHintTimerType := ahttNone;
      end
    else
      HideHint;
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.UpdateVisible;
 ------------------------------------------------------------------------------}
procedure TApplication.UpdateVisible;

  function UseAppTaskbarItem(AForm: TCustomForm): Boolean; inline;
  begin
    Result := (AForm = MainForm) or (AForm.ShowInTaskBar in [stNever, stDefault]);
  end;

  function HasVisibleForms: Boolean;
  var
    i: integer;
    AForm: TCustomForm;
  begin
    Result := False;
    // how to count correct? Do we need to count TCustomForms exclude THintWindow
    // or just count TForm descendants?
    for i := 0 to Screen.FormCount - 1 do
    begin
      AForm := Screen.Forms[i];
      if AForm.Visible and (AForm.Parent = nil) and UseAppTaskbarItem(AForm) then
      begin
        Result := True;
        break;
      end;
    end;
  end;

begin
  // if there are visible forms wich shares application taskbar item then application
  // task bar item must be visible too else hide it
  WidgetSet.AppSetVisible(HasVisibleForms);
end;

{------------------------------------------------------------------------------
  procedure TApplication.DoIdleActions;
 ------------------------------------------------------------------------------}
procedure TApplication.DoIdleActions;
var
  i: Integer;
  CurForm: TCustomForm;
  AForm: TForm;
begin
  for i := 0 to Screen.CustomFormCount - 1 do begin
    CurForm:=Screen.CustomForms[I];
    if CurForm.HandleAllocated and CurForm.Visible and CurForm.Enabled then
      CurForm.UpdateActions;
  end;
  if FFormList<>nil then begin
    for i:=0 to FFormList.Count-1 do begin
      AForm:=TForm(FFormList[i]);
      if AForm.FormStyle=fsSplash then
        AForm.Hide;
    end;
  end;
end;

procedure TApplication.MenuPopupHandler(Sender: TObject);
begin
  HideHint;
end;

{------------------------------------------------------------------------------
  Method: TApplication.ProcessAsyncCallQueue

  Call all methods queued to be called (QueueAsyncCall)
 ------------------------------------------------------------------------------}
procedure TApplication.ProcessAsyncCallQueue;
var
  lItem: PAsyncCallQueueItem;
  Event: TDataEvent;
  Data: PtrInt;
begin
  // take care: we may be called from within lItem^.Method
  while FAsyncCallQueue <> nil do
  begin
    lItem := FAsyncCallQueue;
    FAsyncCallQueue := lItem^.NextItem;
    Event:=lItem^.Method;
    Data:=lItem^.Data;
    Dispose(lItem);
    Event(Data);
  end;
  FAsyncCallQueueLast := nil;
end;

procedure TApplication.DoBeforeFinalization;
var
  i: Integer;
begin
  if Self=nil then exit;
  for i := ComponentCount - 1 downto 0 do 
  begin
    // DebugLn('TApplication.DoBeforeFinalization ',DbgSName(Components[i]));
    if i < ComponentCount then 
      Components[i].Free;
  end;
end;

function TApplication.GetParams(Index: Integer): string;
begin
  Result:=ParamStrUTF8(Index);
end;

{------------------------------------------------------------------------------
  Method: TApplication.IconChanged
 ------------------------------------------------------------------------------}
procedure TApplication.IconChanged(Sender: TObject);
var
  i: integer;
begin
  FreeIconHandles;
  Widgetset.AppSetIcon(SmallIconHandle, BigIconHandle);
  if FFormList <> nil then
    for i := 0 to FFormList.Count - 1 do
      TForm(FFormList[i]).Perform(CM_ICONCHANGED, 0, 0);
end;

{------------------------------------------------------------------------------
  Method: TApplication.SmallIconHandle
  Returns: handle of application icon
 ------------------------------------------------------------------------------}
function TApplication.SmallIconHandle: HIcon;
begin
  if not Icon.Empty then
  begin
    if FSmallIconHandle = 0 then
    begin
      Icon.OnChange := nil;
      Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON)));
      FSmallIconHandle := Icon.ReleaseHandle;
      Icon.OnChange := @IconChanged;
    end;
    Result := FSmallIconHandle;
  end
  else
    Result := 0;
end;

{------------------------------------------------------------------------------
  Method: TApplication.BigIconHandle
  Returns: handle of application icon
 ------------------------------------------------------------------------------}
function TApplication.BigIconHandle: HIcon;
begin
  if not Icon.Empty then
  begin
    if FBigIconHandle = 0 then
    begin
      Icon.OnChange := nil;
      Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)));
      FBigIconHandle := Icon.ReleaseHandle;
      Icon.OnChange := @IconChanged;
    end;
    Result := FBigIconHandle;
  end
  else
    Result := 0;
end;

{------------------------------------------------------------------------------
  Method: TApplication.GetTitle
  Returns: title of application
 ------------------------------------------------------------------------------}
function TApplication.GetTitle: string;
begin
  Result := inherited Title;
  if Result = '' then
    Result := ExtractFileNameOnly(GetExeName);
end;

procedure TApplication.FreeIconHandles;
begin
  if FSmallIconHandle <> 0 then
  begin
    DestroyIcon(FSmallIconHandle);
    FSmallIconHandle := 0;
  end;

  if FBigIconHandle <> 0 then
  begin
    DestroyIcon(FBigIconHandle);
    FBigIconHandle := 0;
  end;
end;

{------------------------------------------------------------------------------
  Method: TApplication.HandleException
  Params: Sender
  Returns:  Nothing

 ------------------------------------------------------------------------------}
procedure TApplication.HandleException(Sender: TObject);
var
  i: LongInt;
  Skip: Boolean;
begin
  if Self = nil then
    Exit;
  if AppHandlingException in FFlags then
  begin
    // there was an exception during showing the exception -> break the circle
    DebugLn('TApplication.HandleException: ',
      'there was another exception during showing the first exception');
    HaltingProgram:=true;
    DumpExceptionBackTrace;
    Halt;
  end;
  Include(FFlags,AppHandlingException);
  
  if StopOnException then
    inherited Terminate;

  Skip := ExceptObject is EAbort;

  if not (AppNoExceptionMessages in FFlags) then
  begin
    // before we do anything, write it down
    if ExceptObject is Exception then
    begin
      if not Skip then
      begin
        DebugLn('TApplication.HandleException ',Exception(ExceptObject).Message);
        DumpExceptionBackTrace;
      end;
    end else
    begin
      DebugLn('TApplication.HandleException Strange Exception ');
      DumpExceptionBackTrace;
    end;
  end;
  // release capture and hide all forms with stay on top, so that
  // a message can be shown
  if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
  if not Skip then
    RemoveStayOnTop;
  // handle the exception
  if ExceptObject is Exception then
  begin
    if not Skip then
    begin
      i := FApplicationHandlers[ahtException].Count;
      if Assigned(OnException) or (i > 0) then
      begin
        if Assigned(OnException) then
          OnException(Sender, Exception(ExceptObject));
        while FApplicationHandlers[ahtException].NextDownIndex(i) do
          TExceptionEvent(FApplicationHandlers[ahtException][i])(Sender, Exception(ExceptObject));
      end
      else
        ShowException(Exception(ExceptObject));
    end;
  end
  else
    SysUtils.ShowException(ExceptObject, ExceptAddr);
  if not Skip then
    RestoreStayOnTop;
  Exclude(FFlags, AppHandlingException);
end;

{------------------------------------------------------------------------------
  Method: TApplication.HandleMessage
  Params: None
  Returns:  Nothing

  Handles all messages first then the Idle
 ------------------------------------------------------------------------------}
procedure TApplication.HandleMessage;
begin
  WidgetSet.AppProcessMessages; // process all events
  if not Terminated then Idle(true);
end;

function TApplication.HelpContext(Sender: TObject; const Position: TPoint;
  Context: THelpContext): Boolean;
begin
  if ValidateHelpSystem then begin
    Result := ShowHelpOrErrorForContext('',Context)=shrSuccess;
  end else
    Result := false;
end;

{------------------------------------------------------------------------------
  function TApplication.HelpContext(Context: THelpContext): Boolean;
------------------------------------------------------------------------------}
function TApplication.HelpContext(Context: THelpContext): Boolean;
begin
  Result:=HelpContext(nil,Point(0,0),Context);
end;

function TApplication.HelpKeyword(Sender: TObject; const Position: TPoint;
  const Keyword: String): Boolean;
begin
  if ValidateHelpSystem then begin
    Result := ShowHelpOrErrorForKeyword('',Keyword)=shrSuccess;
  end else
    Result := false;
end;

{------------------------------------------------------------------------------
  function TApplication.HelpKeyword(const Keyword: String): Boolean;
------------------------------------------------------------------------------}
function TApplication.HelpKeyword(const Keyword: String): Boolean;
begin
  Result:=HelpKeyword(nil,Point(0,0),Keyword);
end;

procedure TApplication.ShowHelpForObject(Sender: TObject);
begin
  if Sender is TControl then begin
    TControl(Sender).ShowHelp;
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.RemoveStayOnTop;
------------------------------------------------------------------------------}
procedure TApplication.RemoveStayOnTop;
var
  i: Integer;
  AForm: TCustomForm;
begin
  if WidgetSet.AppRemoveStayOnTopFlags then
    Exit;
  if Screen = nil then
    Exit;
  for i := 0 to Screen.CustomFormCount - 1 do
  begin
    AForm := Screen.CustomForms[i];
    if (AForm.Parent <> nil) or not AForm.Visible then
      Continue;
    if (AForm.FormStyle in fsAllStayOnTop) then
    begin
      AForm.FormStyle := fsNormal;
      if FRestoreStayOnTop = nil then
        FRestoreStayOnTop := TList.Create;
      if FRestoreStayOnTop.IndexOf(AForm) = -1 then
        FRestoreStayOnTop.Add(AForm);
    end;
  end;
end;

procedure TApplication.RestoreStayOnTop;
var
  i: integer;
begin
  if WidgetSet.AppRestoreStayOnTopFlags then
    Exit;
  if FRestoreStayOnTop <> nil then
    for i := FRestoreStayOnTop.Count - 1 downto 0 do
    begin
      TCustomForm(FRestoreStayOnTop[i]).FormStyle := fsStayOnTop;
      FRestoreStayOnTop.Delete(i);
    end;
end;

{------------------------------------------------------------------------------
  function TApplication.IsWaiting: boolean;
------------------------------------------------------------------------------}
function TApplication.IsWaiting: boolean;
begin
  Result:=AppWaiting in FFlags;
end;

{------------------------------------------------------------------------------
  procedure TApplication.CancelHint;
------------------------------------------------------------------------------}
procedure TApplication.CancelHint;
begin
  StopHintTimer;
  HideHint;
  FHintControl := nil;
  FHintTimerType := ahttNone;
end;

{------------------------------------------------------------------------------
  procedure TApplication.HideHint;
------------------------------------------------------------------------------}
procedure TApplication.HideHint;
begin
  if FHintWindow <> nil then
    FHintWindow.Visible := False;
end;

{------------------------------------------------------------------------------
  TApplication Run
  MainForm is loaded and control is passed to event processor.
------------------------------------------------------------------------------}
procedure TApplication.Run;
begin
  if (FMainForm <> nil) and FShowMainForm then FMainForm.Show;
  WidgetSet.AppRun(@RunLoop);
end;

{------------------------------------------------------------------------------
  TApplication RunLoop
  control is passed to event processor.
------------------------------------------------------------------------------}
procedure TApplication.RunLoop;
begin
  repeat
    if CaptureExceptions then
      try // run with try..except
        HandleMessage;
      except
        HandleException(Self);
      end
    else
      HandleMessage; // run without try..except
  until Terminated;
end;

procedure TApplication.Activate;
begin
  if AppActive in FFlags then exit;
  Include(FFlags,AppActive);
  NotifyActivateHandler;
end;

procedure TApplication.Deactivate;
begin
  if (not (AppActive in FFlags)) then exit;
  if (FindControl(GetFocus)<>nil) then begin
    // another control of this application has got the focus
    exit;
  end;
  Exclude(FFlags,AppActive);
  NotifyDeactivateHandler;
end;

{------------------------------------------------------------------------------}
{       TApplication WndPRoc                                                   }
{                                                                              }
{------------------------------------------------------------------------------}
procedure TApplication.WndProc(var AMessage : TLMessage);
begin
  case AMessage.Msg of
    CM_ACTIONEXECUTE, CM_ACTIONUPDATE: AMessage.Result := LResult(DispatchAction(AMessage.Msg, TBasicAction(AMessage.LParam)));
  else
    Dispatch(AMessage);
  end;
end;

function TApplication.DispatchAction(Msg: Longint; Action: TBasicAction): Boolean;
var
  Form: TCustomForm;
begin
  Result := False;
  Form := Screen.ActiveForm;
  if (Form <> nil) and (Form.Perform(Msg, 0, PtrInt(Action)) = 1) then
    Result := True
  else
  if (MainForm <> Form) and (MainForm <> nil) and (MainForm.Perform(Msg, 0, PtrInt(Action)) = 1) then
    Result := True;
  // Disable action if no "user" handler is available
  if (not Result) and (Action is TCustomAction) and
     TCustomAction(Action).Enabled and TCustomAction(Action).DisableIfNoHandler then
    TCustomAction(Action).Enabled := Assigned(Action.OnExecute);
end;

procedure TApplication.AddHandler(HandlerType: TApplicationHandlerType;
  const Handler: TMethod; AsLast: Boolean);
begin
  if Handler.Code=nil then RaiseGDBException('TApplication.AddHandler');
  if FApplicationHandlers[HandlerType]=nil then
    FApplicationHandlers[HandlerType]:=TMethodList.Create;
  FApplicationHandlers[HandlerType].Add(Handler,AsLast);
end;

procedure TApplication.RemoveHandler(HandlerType: TApplicationHandlerType;
  const Handler: TMethod);
begin
  FApplicationHandlers[HandlerType].Remove(Handler);
end;

function TApplication.GetConsoleApplication: boolean;
begin
  Result:=false;
end;

procedure TApplication.SetHint(const AValue: string);
begin
  if FHint = AValue then
    Exit;
  FHint := AValue;
  if Assigned(FOnHint) or (FApplicationHandlers[ahtHint].Count > 0) then
  begin
    if Assigned(FOnHint) then
      FOnHint(Self);
    FApplicationHandlers[ahtHint].CallNotifyEvents(Self);
  end else
  begin
    // Send THintAction
    with TCustomHintAction.Create(Self) do
    begin
      Hint := FHint;
      try
        Execute;
      finally
        Free;
      end;
    end;
  end;
end;

procedure TApplication.SetHintColor(const AValue: TColor);
begin
  if FHintColor = AValue then
    exit;
  FHintColor := AValue;
  if FHintWindow <> nil then
    FHintWindow.Color := FHintColor;
end;

procedure TApplication.DoOnIdleEnd;
begin
  if (AppIdleEndSent in FFlags) then exit;
  if Assigned(OnIdleEnd) then OnIdleEnd(Self);
  NotifyIdleEndHandler;
  Include(FFlags,AppIdleEndSent);
end;

function TApplication.GetActive: boolean;
begin
  Result := AppActive in Flags;
end;

{------------------------------------------------------------------------------
  function TApplication.GetCurrentHelpFile: string;
------------------------------------------------------------------------------}
function TApplication.GetCurrentHelpFile: string;
var
  ActiveForm: TCustomForm;
begin
  ActiveForm := Screen.ActiveCustomForm;
  if Assigned(ActiveForm) and (ActiveForm.FHelpFile <> '') then
    Result := ActiveForm.HelpFile
  else
    Result := HelpFile;
end;

{------------------------------------------------------------------------------
       TApplication ShowException
------------------------------------------------------------------------------}
procedure TApplication.ShowException(E: Exception);
var
  Msg: string;
  MsgResult: Integer;
begin
  if AppNoExceptionMessages in FFlags then exit;
  Msg := E.Message;
  if FindInvalidUTF8Character(PChar(Msg), Length(Msg), False) > 0 then
    Msg := AnsiToUtf8(Msg);
  if (Msg <> '') and (Msg[length(Msg)] <> '.') then Msg := Msg + '.';
  if (not Terminated) and (Self <> nil) and (AppInitialized in FFlags) then
  begin
    DisableIdleHandler;
    try
      MsgResult:=MessageBox(PChar(Format(
        rsPressOkToIgnoreAndRiskDataCorruptionPressCancelToK, [Msg, #13#13, #13]
        )), PChar(GetTitle),
                            MB_OKCANCEL + MB_ICONERROR);
    finally
      EnableIdleHandler;
    end;
    if MsgResult<>mrOk then
    begin
      Include(FFlags, AppNoExceptionMessages);
      HaltingProgram := True;
      Halt;
    end;
  end else
    inherited ShowException(E);
end;

{------------------------------------------------------------------------------
       TApplication Terminate
       Class is terminated and the component engine is shutdown
------------------------------------------------------------------------------}
procedure TApplication.Terminate;
begin
  inherited Terminate;
  WidgetSet.AppTerminate;
end;

procedure TApplication.DisableIdleHandler;
begin
  inc(FIdleLockCount);
end;

procedure TApplication.EnableIdleHandler;
begin
  if FIdleLockCount<=0 then
    RaiseGDBException('TApplication.EnableIdleHandler');
  dec(FIdleLockCount);
end;

{------------------------------------------------------------------------------
  procedure TApplication.NotifyUserInputHandler;

 ------------------------------------------------------------------------------}
procedure TApplication.NotifyUserInputHandler(Msg: Cardinal);
var
  i: integer;
begin
  FLastMouseControlValid := False;
  case Msg of
    LM_MOUSEMOVE:
      DoOnMouseMove;
    else
      CancelHint;
  end;
  
  if Assigned(FOnUserInput) then
    FOnUserInput(Self, Msg);

  i := FApplicationHandlers[ahtUserInput].Count;
  while FApplicationHandlers[ahtUserInput].NextDownIndex(i) do
    TOnUserInputEvent(FApplicationHandlers[ahtUserInput][i])(Self, Msg);
end;

procedure TApplication.NotifyKeyDownBeforeHandler(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  i: Integer;
begin
  i:=FApplicationHandlers[ahtKeyDownBefore].Count;
  while FApplicationHandlers[ahtKeyDownBefore].NextDownIndex(i) do
    TKeyEvent(FApplicationHandlers[ahtKeyDownBefore][i])(Sender,Key,Shift);
end;

procedure TApplication.NotifyKeyDownHandler(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  i: Integer;
begin
  i:=FApplicationHandlers[ahtKeyDownAfter].Count;
  while FApplicationHandlers[ahtKeyDownAfter].NextDownIndex(i) do
    TKeyEvent(FApplicationHandlers[ahtKeyDownAfter][i])(Sender,Key,Shift);
  if WidgetSet.IsHelpKey(Key, Shift) then
    ShowHelpForObject(Sender);
end;

procedure TApplication.ControlKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AControl: TWinControl;
begin
  if Sender is TWinControl then
  begin
    AControl := TWinControl(Sender);
    //debugln('TApplication.ControlKeyDown A ',DbgSName(AControl));
    FLastKeyDownSender := AControl;

    // handle navigation key
    DoTabKey(AControl, Key, Shift);
    DoArrowKey(AControl, Key, Shift);
  end else
    FLastKeyDownSender := nil;
  //DebugLn(['TApplication.ControlKeyDown Sender=',DbgSName(Sender),' Key=',Key,' Shift=',dbgs(Shift)]);
  FLastKeyDownKey := Key;
  FLastKeyDownShift := Shift;
end;

procedure TApplication.ControlKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  AControl: TWinControl;
begin
  if Key=VK_UNKNOWN then exit;

  if Sender is TWinControl then begin
    AControl:=TWinControl(Sender);
    //debugln('TApplication.ControlKeyUp A ',DbgSName(AControl),' Key=',dbgs(Key),' Shift=',dbgs(Shift));
    if FLastKeyDownKey=VK_UNKNOWN then begin
      // key was already handled in key down
      //debugln('TApplication.ControlKeyUp key was handled in key down');
      exit;
    end;
    if (Key<>FLastKeyDownKey) or (Shift<>FLastKeyDownShift)
    or (AControl<>FLastKeyDownSender) then begin
      // a key up, without key down
      //debugln('TApplication.ControlKeyUp key was handled in key down or in key up');
      exit;
    end;

    // handle special navigation keys
    DoReturnKey(AControl, Key, Shift);
    DoEscapeKey(AControl, Key, Shift);
  end;
  FLastKeyDownKey := VK_UNKNOWN;
end;

procedure TApplication.AddOnIdleHandler(Handler: TIdleEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtIdle,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnIdleHandler(Handler: TIdleEvent);
begin
  RemoveHandler(ahtIdle,TMethod(Handler));
end;

procedure TApplication.AddOnIdleEndHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtIdleEnd,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnIdleEndHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtIdleEnd,TMethod(Handler));
end;

procedure TApplication.AddOnUserInputHandler(Handler: TOnUserInputEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtUserInput,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnUserInputHandler(Handler: TOnUserInputEvent);
begin
  RemoveHandler(ahtUserInput,TMethod(Handler));
end;

procedure TApplication.AddOnKeyDownBeforeHandler(Handler: TKeyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtKeyDownBefore,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnKeyDownBeforeHandler(Handler: TKeyEvent);
begin
  RemoveHandler(ahtKeyDownBefore,TMethod(Handler));
end;

procedure TApplication.AddOnKeyDownHandler(Handler: TKeyEvent; AsLast: Boolean);
begin
  AddHandler(ahtKeyDownAfter,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnKeyDownHandler(Handler: TKeyEvent);
begin
  RemoveHandler(ahtKeyDownAfter,TMethod(Handler));
end;

procedure TApplication.AddOnActivateHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtActivate,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnActivateHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtActivate,TMethod(Handler));
end;

procedure TApplication.AddOnDeactivateHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtDeactivate,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnDeactivateHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtDeactivate,TMethod(Handler));
end;

procedure TApplication.AddOnExceptionHandler(Handler: TExceptionEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtException,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnExceptionHandler(Handler: TExceptionEvent);
begin
  RemoveHandler(ahtException,TMethod(Handler));
end;

procedure TApplication.AddOnEndSessionHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtEndSession,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnEndSessionHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtEndSession,TMethod(Handler));
end;

procedure TApplication.AddOnQueryEndSessionHandler(
  Handler: TQueryEndSessionEvent; AsLast: Boolean);
begin
  AddHandler(ahtQueryEndSession,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnQueryEndSessionHandler(
  Handler: TQueryEndSessionEvent);
begin
  RemoveHandler(ahtQueryEndSession,TMethod(Handler));
end;

procedure TApplication.AddOnMinimizeHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtMinimize,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnMinimizeHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtMinimize,TMethod(Handler));
end;

procedure TApplication.AddOnRestoreHandler(Handler: TNotifyEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtRestore,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnRestoreHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtRestore,TMethod(Handler));
end;

procedure TApplication.AddOnDropFilesHandler(Handler: TDropFilesEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtDropFiles,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnDropFilesHandler(Handler: TDropFilesEvent);
begin
  RemoveHandler(ahtDropFiles,TMethod(Handler));
end;

procedure TApplication.AddOnHelpHandler(Handler: THelpEvent; AsLast: Boolean);
begin
  AddHandler(ahtHelp,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnHelpHandler(Handler: THelpEvent);
begin
  RemoveHandler(ahtHelp,TMethod(Handler));
end;

procedure TApplication.AddOnHintHandler(Handler: TNotifyEvent; AsLast: Boolean
  );
begin
  AddHandler(ahtHint,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnHintHandler(Handler: TNotifyEvent);
begin
  RemoveHandler(ahtHint,TMethod(Handler));
end;

procedure TApplication.AddOnShowHintHandler(Handler: TShowHintEvent;
  AsLast: Boolean);
begin
  AddHandler(ahtShowHint,TMethod(Handler),AsLast);
end;

procedure TApplication.RemoveOnShowHintHandler(Handler: TShowHintEvent);
begin
  RemoveHandler(ahtShowHint,TMethod(Handler));
end;

procedure TApplication.RemoveAllHandlersOfObject(AnObject: TObject);
var
  HandlerType: TApplicationHandlerType;
begin
  for HandlerType:=Low(TApplicationHandlerType) to High(TApplicationHandlerType)
  do
    FApplicationHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
end;

{------------------------------------------------------------------------------
  procedure TApplication.IntfEndSession;
------------------------------------------------------------------------------}
procedure TApplication.IntfEndSession;
begin
  if Assigned(FOnEndSession) then FOnEndSession(Self);
  FApplicationHandlers[ahtEndSession].CallNotifyEvents(Self);
end;

{------------------------------------------------------------------------------
  procedure TApplication.IntfQueryEndSession(var Cancel : Boolean);
------------------------------------------------------------------------------}
procedure TApplication.IntfQueryEndSession(var Cancel : Boolean);
var
  i: LongInt;
begin
  if Assigned(FOnQueryEndSession) then FOnQueryEndSession(Cancel);
  i:=FApplicationHandlers[ahtQueryEndSession].Count;
  while FApplicationHandlers[ahtQueryEndSession].NextDownIndex(i) do
    TQueryEndSessionEvent(FApplicationHandlers[ahtQueryEndSession][i])(Cancel);
end;

{------------------------------------------------------------------------------
  procedure TApplication.IntfAppMinimize;
------------------------------------------------------------------------------}
procedure TApplication.IntfAppMinimize;
begin
  if Assigned(FOnMinimize) then FOnMinimize(Self);
  FApplicationHandlers[ahtMinimize].CallNotifyEvents(Self);
end;

{------------------------------------------------------------------------------
  procedure TApplication.IntfAppRestore;
------------------------------------------------------------------------------}
procedure TApplication.IntfAppRestore;
begin
  Screen.RestoreLastActive;
  if Assigned(FOnRestore) then FOnRestore(Self);
  FApplicationHandlers[ahtRestore].CallNotifyEvents(Self);
end;

{------------------------------------------------------------------------------
  Method:  TApplication.IntfDropFiles
  Params:  FileNames - Dropped files

  Invokes OnDropFilesEvent of the application.
  This function is called by the interface.
 ------------------------------------------------------------------------------}
procedure TApplication.IntfDropFiles(const FileNames: array of String);
var
  i: LongInt;
begin
  if Assigned(FOnDropFiles) then FOnDropFiles(Self, FileNames);
  i:=FApplicationHandlers[ahtDropFiles].Count;
  while FApplicationHandlers[ahtDropFiles].NextDownIndex(i) do
    TDropFilesEvent(FApplicationHandlers[ahtDropFiles][i])(Self,Filenames);
end;

procedure TApplication.IntfThemeOptionChange(AThemeServices: TThemeServices;
  AOption: TThemeOption);
begin
  case AOption of
    toShowButtonImages:
      if ShowButtonGlyphs = sbgSystem then
        NotifyCustomForms(CM_APPSHOWBTNGLYPHCHANGED);
    toShowMenuImages:
      if ShowMenuGlyphs = sbgSystem then
        NotifyCustomForms(CM_APPSHOWMENUGLYPHCHANGED);
  end;
end;

procedure TApplication.DoArrowKey(AControl: TWinControl; var Key: Word;
  Shift: TShiftState);
begin
  if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) and (Shift = []) and
     (anoArrowToSelectNextInParent in Navigation) and AControl.Focused and
     (AControl.Parent <> nil) and
     (AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
  begin
    // traverse controls inside parent
    AControl.Parent.SelectNext(AControl, Key in [VK_RIGHT, VK_DOWN], False);
    Key := VK_UNKNOWN;
  end;
end;

{------------------------------------------------------------------------------
  procedure TApplication.DoBeforeMouseMessage(CurMouseControl: TControl);
------------------------------------------------------------------------------}
procedure TApplication.DoBeforeMouseMessage(CurMouseControl: TControl);
begin
  //debugln(['TApplication.DoBeforeMouseMessage ',DbgSName(CurMouseControl)]);
  UpdateMouseControl(GetControlAtMouse);
end;

function TApplication.IsShortcut(var Message: TLMKey): boolean;
var
  ModalForm: TCustomForm;
begin
  Result := false;
  if Assigned(FOnShortcut) then
  begin
    FOnShortcut(Message, Result);
    if Result then
      exit;
  end;

  // next: if there is a modal form, let it handle the short cut
  ModalForm:=Screen.GetCurrentModalForm;
  if ModalForm<>nil then begin
    Result := ModalForm.IsShortcut(Message);
  end else begin
    // there is no modal form

    // let the current focused form handle the shortcut
    if Screen.ActiveCustomForm<>nil then begin
      Result := Screen.ActiveCustomForm.IsShortcut(Message);
      if Result then exit;
    end;

    // let the main form handle the shortcut
    if (MainForm<>nil) and (Screen.ActiveCustomForm<>MainForm) then begin
      Result := FMainForm.IsShortcut(Message);
      if Result then exit;
    end;
  end;
end;

procedure TApplication.DoEscapeKey(AControl: TWinControl; var Key: Word;
  Shift: TShiftState);
var
  Form: TCustomForm;
begin
  if (Shift = []) and (Key = VK_ESCAPE) then begin
    Form := GetParentForm(AControl);
    if Form<>nil then begin
      if (anoEscapeForCancelControl in Navigation) then begin
        if (Form.CancelControl <> nil) then
        begin
          //debugln('TApplication.ControlKeyUp VK_ESCAPE ', Acontrol.Name);
          Form.CancelControl.ExecuteCancelAction;
          Key := VK_UNKNOWN;
        end;
      end;
    end;
  end;
end;

procedure TApplication.DoReturnKey(AControl: TWinControl; var Key: Word;
  Shift: TShiftState);
var
  Form: TCustomForm;
  lDefaultControl: TControl;
begin
  if (Shift = []) and (Key = VK_RETURN) then begin
    //DebugLn(['TApplication.DoReturnKey ',DbgSName(AControl)]);
    Form := GetParentForm(AControl);
    if Form<>nil then begin
      if anoReturnForDefaultControl in Navigation then
      begin
        lDefaultControl := Form.ActiveDefaultControl;
        if lDefaultControl = nil then
          lDefaultControl := Form.DefaultControl;
        if (lDefaultControl <> nil)
          and ((lDefaultControl.Parent = nil) or (lDefaultControl.Parent.CanFocus))
          and lDefaultControl.Enabled and lDefaultControl.Visible then
        begin
          //debugln('TApplication.ControlKeyUp VK_RETURN ', Acontrol.Name);
          lDefaultControl.ExecuteDefaultAction;
          Key := VK_UNKNOWN;
        end;
      end;
    end;
  end;
end;

procedure TApplication.DoTabKey(AControl: TWinControl; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_TAB) and ((Shift - [ssShift]) = []) and
     (anoTabToSelectNext in Navigation) and AControl.Focused and
     (AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
  begin
    // traverse tabstop controls inside form
    AControl.PerformTab(not (ssShift in Shift));
    Key := VK_UNKNOWN;
  end;
end;

{------------------------------------------------------------------------------
  TApplication CreateForm

  Note: The name is confusing and only kept for Delphi compatibility. It can
  create any kind of components.

  Create a Component instance and sets the pointer to the component variable
  and loads the component. If it is a form it will be added to the applications
  forms list
------------------------------------------------------------------------------}
procedure TApplication.CreateForm(InstanceClass: TComponentClass;
  out Reference);
var
  Instance: TComponent;
  ok: boolean;
  AForm: TForm;
begin
  // Allocate the instance, without calling the constructor
  Instance := TComponent(InstanceClass.NewInstance);
  // set the Reference before the constructor is called, so that
  // events and constructors can refer to it
  TComponent(Reference) := Instance;

  ok:=false;
  try
    if (FCreatingForm=nil) and (Instance is TForm) then
      FCreatingForm:=TForm(Instance);
    Instance.Create(Self);
    ok:=true;
  finally
    if not ok then begin
      TComponent(Reference) := nil;
      if FCreatingForm=Instance then
        FCreatingForm:=nil;
    end;
  end;

  if (Instance is TForm) then
  begin
    AForm := TForm(Instance);
    UpdateMainForm(AForm);
    if FMainForm = AForm then
      AForm.HandleNeeded;
    if not Assigned(FFormList) then
      FFormList := TList.Create;
    FFormList.Add(AForm);
    if AForm.FormStyle = fsSplash then
    begin
      // show the splash form and handle the paint message
      AForm.Show;
      AForm.Paint;
      ProcessMessages;
    end;
  end;
  {$IFDEF AfterConstructionDataModuleNotWorking}
  if (Instance is TDataModule) then
  begin
    TDataModule(instance).AfterConstruction;
  end;
  {$ENDIF}
end;

procedure TApplication.UpdateMainForm(AForm: TForm);
begin
  if (FMainForm = nil)
  and (FCreatingForm=AForm)
  and (not (AppDestroying in FFlags))
  and not (AForm.FormStyle in [fsMDIChild, fsSplash])
  then
    FMainForm := AForm;
end;

procedure TApplication.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
var
  lItem: PAsyncCallQueueItem;
begin
  if AppDoNotCallAsyncQueue in FFlags then
    raise Exception.Create('TApplication.QueueAsyncCall already shut down');
  New(lItem);
  lItem^.Method := AMethod;
  lItem^.Data := Data;
  lItem^.NextItem := nil;
  if FAsyncCallQueue = nil then
    FAsyncCallQueue := lItem
  else
    FAsyncCallQueueLast^.NextItem := lItem;
  FAsyncCallQueueLast := lItem;
end;

procedure TApplication.FreeComponent(Data: PtrInt);
begin
  if Data<>0 then
    DebugLn(['HINT: TApplication.FreeComponent Data<>0 ignored']);
  ReleaseComponents;
end;

procedure TApplication.ReleaseComponents;
var
  List: TFPList;
  Node: TAvgLvlTreeNode;
  Component: TComponent;
  i: Integer;
begin
  if FComponentsToRelease<>nil then begin
    // free components
    // Notes:
    //   - check TLCLComponent.LCLRefCount=0
    //   - during freeing new components can be added to the FComponentsToRelease
    List:=nil;
    try
      // collect all components that can be freed
      Node:=FComponentsToRelease.FindLowest;
      while Node<>nil do begin
        Component:=TComponent(Node.Data);
        if (not (Component is TLCLComponent))
        or (TLCLComponent(Component).LCLRefCount=0) then begin
          if List=nil then
            List:=TFPList.Create;
          List.Add(Component);
        end;
        Node:=FComponentsToRelease.FindSuccessor(Node);
      end;
      // free components
      if List<>nil then
        for i:=0 to List.Count-1 do begin
          Component:=TComponent(List[i]);
          FComponentsToRelease.Remove(Component);
          //DebugLn(['TApplication.ReleaseComponents ',DbgSName(Component)]);
          Component.Free;
        end;
    finally
      List.Free;
    end;
    if FComponentsToRelease.Count=0 then
      FreeAndNil(FComponentsToRelease);
  end;
end;

procedure TApplication.ReleaseComponent(AComponent: TComponent);
var
  IsFirstItem: Boolean;
begin
  if csDestroying in AComponent.ComponentState then exit;
  //DebugLn(['TApplication.ReleaseComponent ',DbgSName(AComponent)]);
  if AppDestroying in FFlags then begin
    // free immediately
    AComponent.Free;
  end else begin
    // free later
    // => add to the FComponentsToRelease
    IsFirstItem:=FComponentsToRelease=nil;
    if IsFirstItem then
      FComponentsToRelease:=TAvgLvlTree.Create(@ComparePointers)
    else if FComponentsToRelease.Find(AComponent)<>nil then
      exit;
    FComponentsToRelease.Add(AComponent);
    AComponent.FreeNotification(Self);
    if IsFirstItem then
      QueueAsyncCall(@FreeComponent, 0);
  end;
end;

function TApplication.ExecuteAction(ExeAction: TBasicAction): Boolean;
begin
  Result := False;
  if Assigned(FOnActionExecute) then FOnActionExecute(ExeAction, Result);
end;

function TApplication.UpdateAction(TheAction: TBasicAction): Boolean;
begin
  Result := False;
  if Assigned(FOnActionUpdate) then FOnActionUpdate(TheAction, Result);
end;