I want to build a menu form that acts similar to ribbon keytips - you can
- press and hold Alt, then press and release e. g. d, then release Alt to trigger an action or
- press and release Alt, then press and release d to trigger the same action
I took inspiration at Hidden Main Menu in a delphi program automatically shown using Alt key and came up with the following demo:
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ImgList,
StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
strict private
FShowKeyTips: Boolean;
procedure UpdateKeyTipState(AShowKeyTips: Boolean);
procedure WMExitMenuLoop(var Message: TMessage); message WM_EXITMENULOOP;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ShellAPI,
Menus;
{ TForm1 }
constructor TForm1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Label1.Caption := 'Dummy';
end;
destructor TForm1.Destroy;
begin
inherited Destroy;
end;
procedure TForm1.WMExitMenuLoop(var Message: TMessage);
begin
UpdateKeyTipState(False);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
const
MAPVK_VK_TO_CHAR = 2;
// Adapted from dxBar.pas:
function IsTextCharForKeyTip(AKey: Word): Boolean;
var
ARes: UINT;
begin
ARes := MapVirtualKey(AKey, MAPVK_VK_TO_CHAR);
Result := ((ARes and $FFFF0000) = 0) and (Char(ARes) <> ' ') and (Char(ARes) in [#32..#255]);
end;
var
hk: string;
CheckKeyTips: Boolean;
begin
if (Key = VK_MENU) or (Key = VK_F10) then
begin
UpdateKeyTipState(True);
Exit;
end;
if FShowKeyTips then
CheckKeyTips := True
else
CheckKeyTips := Shift = [ssAlt];
if CheckKeyTips and IsTextCharForKeyTip(Key) then
begin
hk := Char(Key); // TODO: Handle analogouos to TdxBarItemLink.IsAccel?
if SameText(hk, 'd') then
begin
Caption := Caption + '+';
Key := 0;
Exit;
end;
end;
end;
procedure TForm1.UpdateKeyTipState(AShowKeyTips: Boolean);
begin
if FShowKeyTips = AShowKeyTips then
Exit;
FShowKeyTips := AShowKeyTips;
if AShowKeyTips then
Label1.Caption := 'Dummy (d)'
else
Label1.Caption := 'Dummy';
end;
end.
(Create a standard VCL app, add Label1 to Form1 and replace the contents of Unit1.pas with the above.)
The first bullet point works (adds a + to the form caption), however I can't make the second one work. I can't find where the d gets handled. I tried WM_(SYS)KEYDOWN, CM_DIALOGCHAR and more to no avail.
Any ideas?