Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Adding a shortcut to a programmatically added system menu option

In my application, I have a base form in which various items are added to the system menu, for example

 AppendMenu (SysMenu, MF_SEPARATOR, 0, '');
 AppendMenu (SysMenu, MF_STRING, SC_Sticky, 'Sticky');
 AppendMenu (SysMenu, MF_STRING, SC_Original, 'Original');

How does one add keyboard shortcuts to these menu options (eg Alt-F2, Alt-F3)?

I can't use the standard method of using an accelerator (ie &Sticky for Alt-S) as the real menu captions are in Hebrew and accelerators don't seem to work properly with this language.

like image 337
No'am Newman Avatar asked Sep 30 '12 06:09

No'am Newman


1 Answers

Here's an example that uses an accelerator table:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure FormDestroy(Sender: TObject);
  private
    FAccelTable: HACCEL;
    FAccels: array[0..1] of TAccel;
  protected
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  SC_Sticky = 170;
  SC_Original = 180;

procedure TForm1.FormCreate(Sender: TObject);
var
  SysMenu: HMENU;
begin
 SysMenu := GetSystemMenu(Handle, False);
 AppendMenu (SysMenu, MF_SEPARATOR, 0, '');
 AppendMenu (SysMenu, MF_STRING, SC_Sticky, 'Sticky'#9'Alt+F2');
 AppendMenu (SysMenu, MF_STRING, SC_Original, 'Original'#9'Alt+F3');

 FAccels[0].fVirt := FALT or FVIRTKEY;
 FAccels[0].key := VK_F2;
 FAccels[0].cmd := SC_Sticky;
 FAccels[1].fVirt := FALT or FVIRTKEY;
 FAccels[1].key := VK_F3;
 FAccels[1].cmd := SC_Original;

 FAccelTable := CreateAcceleratorTable(FAccels, 2);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DestroyAcceleratorTable(FAccelTable);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  TranslateAccelerator(Handle, FAccelTable, Msg);
  inherited;
end;

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
  inherited;
  case Message.CmdType of
    SC_Sticky: ShowMessage('sticky');
    SC_Original: ShowMessage('original');
  end;
end;
like image 117
Sertac Akyuz Avatar answered Nov 04 '22 16:11

Sertac Akyuz