Add Windows alt main menu style hotkeys.

Villavu · Oct 14, 2023 · 3d95f2e · 3d95f2e
1 parent 19e23bf
commit 3d95f2e
Show file tree

Hide file tree

Showing 4 changed files with 110 additions and 7 deletions.
diff --git a/Source/Simba.lpi b/Source/Simba.lpi
@@ -340,7 +340,7 @@
         <PackageName Value="LCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="155">
+    <Units Count="158">
       <Unit0>
         <Filename Value="Simba.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -1045,6 +1045,18 @@
         <Filename Value="simba.image_integral.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit154>
+      <Unit155>
+        <Filename Value="image/drawcirclefilled.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit155>
+      <Unit156>
+        <Filename Value="image/drawcircle.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit156>
+      <Unit157>
+        <Filename Value="image/setpixel.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit157>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

diff --git 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
@@ -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
@@ -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);