Skip to content

Commit

Permalink
Add Windows alt main menu style hotkeys.
Browse files Browse the repository at this point in the history
  • Loading branch information
ollydev committed Oct 14, 2023
1 parent 19e23bf commit 3d95f2e
Show file tree
Hide file tree
Showing 4 changed files with 110 additions and 7 deletions.
14 changes: 13 additions & 1 deletion Source/Simba.lpi
Original file line number Diff line number Diff line change
Expand Up @@ -340,7 +340,7 @@
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages>
<Units Count="155">
<Units Count="158">
<Unit0>
<Filename Value="Simba.lpr"/>
<IsPartOfProject Value="True"/>
Expand Down Expand Up @@ -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>
Expand Down
88 changes: 84 additions & 4 deletions Source/components/simba.component_menubar.pas
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
interface

uses
Classes, SysUtils, Controls, Forms, Menus, Graphics, ExtCtrls,
Classes, SysUtils, Controls, Forms, Menus, Graphics, ExtCtrls, LMessages,
simba.settings;

type
Expand All @@ -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);
Expand All @@ -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;
Expand All @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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);
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
5 changes: 3 additions & 2 deletions Source/forms/simba.main.lfm
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
object SimbaForm: TSimbaForm
Left = 3385
Left = 2927
Height = 539
Top = 327
Top = 623
Width = 798
Caption = 'Simba'
ClientHeight = 539
Expand All @@ -10,6 +10,7 @@ object SimbaForm: TSimbaForm
KeyPreview = True
OnClose = FormClose
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnWindowStateChange = FormWindowStateChange
Position = poScreenCenter
LCLVersion = '3.0.0.1'
Expand Down
10 changes: 10 additions & 0 deletions Source/forms/simba.main.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit 3d95f2e

Please sign in to comment.