diff --git a/Source/Simba.lpi b/Source/Simba.lpi index c124a7324..5b918d1f1 100644 --- a/Source/Simba.lpi +++ b/Source/Simba.lpi @@ -340,7 +340,7 @@ - + @@ -1045,6 +1045,18 @@ + + + + + + + + + + + + diff --git a/Source/components/simba.component_menubar.pas b/Source/components/simba.component_menubar.pas index 27f308707..afb2a714b 100644 --- a/Source/components/simba.component_menubar.pas +++ b/Source/components/simba.component_menubar.pas @@ -10,7 +10,7 @@ interface uses - Classes, SysUtils, Controls, Forms, Menus, Graphics, ExtCtrls, + Classes, SysUtils, Controls, Forms, Menus, Graphics, ExtCtrls, LMessages, simba.settings; type @@ -30,7 +30,6 @@ TSimbaMainMenuBar = class(TCustomControl) procedure SetHotIndex(Index: Integer); function IndexAtXY(X, Y: Integer): Integer; - procedure Popup(Index: Integer); procedure DoTrackTimer(Sender: TObject); procedure DoChangePopupMenu(Data: PtrInt); @@ -39,6 +38,7 @@ TSimbaMainMenuBar = class(TCustomControl) procedure CalculateSizes; procedure Paint; override; procedure FontChanged(Sender: TObject); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; @@ -49,19 +49,26 @@ TSimbaMainMenuBar = class(TCustomControl) procedure MaybeReplaceModifiers(Menu: TPopupMenu); function GetMenus: TPopupMenuArray; + + procedure PopupDelayed(Data: PtrInt); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; + procedure SetFocus; override; + + property HotIndex: Integer read FHotIndex write SetHotIndex; property Menus: TPopupMenuArray read GetMenus; + procedure Popup(Index: Integer); procedure AddMenu(Title: String; APopupMenu: TPopupMenu); end; implementation uses - LMessages, LCLIntf, ATCanvasPrimitives, - simba.theme, simba.fonthelpers; + LCLType, LCLIntf, ATCanvasPrimitives, + simba.theme, simba.fonthelpers, simba.scripttabsform; function TSimbaMainMenuBar.GetMenus: TPopupMenuArray; var @@ -72,6 +79,11 @@ function TSimbaMainMenuBar.GetMenus: TPopupMenuArray; Result[I] := FItems[I].Menu; end; +procedure TSimbaMainMenuBar.PopupDelayed(Data: PtrInt); +begin + Popup(Data); +end; + procedure TSimbaMainMenuBar.SetHotIndex(Index: Integer); begin FHotIndex := Index; @@ -212,6 +224,62 @@ procedure TSimbaMainMenuBar.FontChanged(Sender: TObject); CalculateSizes(); end; +procedure TSimbaMainMenuBar.SetFocus; +begin + inherited SetFocus(); + + if (HotIndex = -1) then + HotIndex := 0; +end; + +procedure TSimbaMainMenuBar.KeyDown(var Key: Word; Shift: TShiftState); +var + Msg: TLMKillFocus; +begin + if Focused then + begin + if (Key = VK_MENU) then + begin + Key := VK_RIGHT; + end; + if (Key = VK_ESCAPE) then + begin + WMKillFocus(Msg{%H-}); + Key := 0; + Exit; + end; + + if (Key = VK_RETURN) then + begin + Application.QueueAsyncCall(@PopupDelayed, HotIndex); + Key := 0; + end + else if (HotIndex = -1) then + HotIndex := 0 + else + if (Key = VK_LEFT) then + begin + if (HotIndex = 0) then + HotIndex := High(FItems) + else + HotIndex := HotIndex - 1; + + Key := 0; + end + else if (Key = VK_RIGHT) then + begin + if (HotIndex = High(FItems)) then + HotIndex := 0 + else + HotIndex := HotIndex + 1; + + Key := 0; + end; + end; + + inherited KeyDown(Key, Shift); +end; + procedure TSimbaMainMenuBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); @@ -235,7 +303,10 @@ procedure TSimbaMainMenuBar.MouseLeave; end; procedure TSimbaMainMenuBar.DoMenuClose(Sender: TObject); +var + Msg: TLMKillFocus; begin + WMKillFocus(Msg{%H-}); if (FTrackTimer = nil) then Exit; FTrackTimer.Enabled := False; @@ -297,6 +368,15 @@ destructor TSimbaMainMenuBar.Destroy; inherited Destroy(); end; +procedure TSimbaMainMenuBar.WMKillFocus(var Message: TLMKillFocus); +begin + HotIndex := -1; + + if Assigned(SimbaScriptTabsForm) and Assigned(SimbaScriptTabsForm.CurrentEditor) then + if SimbaScriptTabsForm.CurrentEditor.CanSetFocus() then + SimbaScriptTabsForm.CurrentEditor.SetFocus(); +end; + procedure TSimbaMainMenuBar.AddMenu(Title: String; APopupMenu: TPopupMenu); var I: Integer; diff --git a/Source/forms/simba.main.lfm b/Source/forms/simba.main.lfm index 445525298..46958f495 100644 --- a/Source/forms/simba.main.lfm +++ b/Source/forms/simba.main.lfm @@ -1,7 +1,7 @@ object SimbaForm: TSimbaForm - Left = 3385 + Left = 2927 Height = 539 - Top = 327 + Top = 623 Width = 798 Caption = 'Simba' ClientHeight = 539 @@ -10,6 +10,7 @@ object SimbaForm: TSimbaForm KeyPreview = True OnClose = FormClose OnDestroy = FormDestroy + OnKeyDown = FormKeyDown OnWindowStateChange = FormWindowStateChange Position = poScreenCenter LCLVersion = '3.0.0.1' diff --git a/Source/forms/simba.main.pas b/Source/forms/simba.main.pas index 91b551c3e..e91bb2cdf 100644 --- a/Source/forms/simba.main.pas +++ b/Source/forms/simba.main.pas @@ -179,6 +179,7 @@ TSimbaForm = class(TForm) procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormDestroy(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShortCut(var Msg: TLMKey; var Handled: Boolean); procedure FormWindowStateChange(Sender: TObject); procedure ImagesGetWidthForPPI(Sender: TCustomImageList; AImageWidth, APPI: Integer; var AResultWidth: Integer); @@ -719,6 +720,12 @@ procedure TSimbaForm.FormDestroy(Sender: TObject); SimbaSettings.Save(); end; +procedure TSimbaForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Key = VK_MENU) and MenuBar.CanSetFocus() then + MenuBar.SetFocus(); +end; + procedure TSimbaForm.FormShortCut(var Msg: TLMKey; var Handled: Boolean); begin Handled := MainMenuFile.IsShortcut(Msg) or MainMenuView.IsShortcut(Msg) or @@ -791,6 +798,9 @@ procedure TSimbaForm.MenuItemScriptStateClick(Sender: TObject); Pause: CurrentTab.Pause(); Stop: CurrentTab.Stop(); end; + + if CurrentTab.Editor.CanSetFocus() then + CurrentTab.Editor.SetFocus(); except on E: Exception do MessageDlg('Exception while changing script state: ' + E.Message, mtError, [mbOK], 0);