source: trunk/Packages/Common/Forms/FormKeyShortcuts.pas

unit FormKeyShortcuts;

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ComCtrls, ActnList, LCLProc, Menus, FormEx, Generics.Collections, ImgList,
  StdCtrls, ListViewSort;

type

  { TFormKeyShortcuts }

  TFormKeyShortcuts = class(TFormEx)
    ListView1: TListView;
    ListViewSort1: TListViewSort;
    MenuItem1: TMenuItem;
    PopupMenu1: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView1KeyPress(Sender: TObject; var Key: char);
    function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
    procedure MenuItem1Click(Sender: TObject);
  private
    function GetImageList: TCustomImageList;
    procedure SetImageList(AValue: TCustomImageList);
  public
    SourceComponents: TObjectList<TComponent>;
    MainForm: TForm;
    procedure LoadFromComponent(C: TComponent);
    property ImageList: TCustomImageList read GetImageList write SetImageList;
  end;


implementation

{$R *.lfm}

resourcestring
  SMainForm = 'Main window';
  SGlobal = 'Global';
  // TODO: https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/41095
  {$hints off}
  SAction = 'Action';
  SWindow = 'Window';
  SExecute = 'Execute';
  SShortcut = 'Shortcut';
  SKeyShortcuts = 'Key shortcuts';

{ TFormKeyShortcuts }

procedure TFormKeyShortcuts.FormShow(Sender: TObject);
var
  I: Integer;
begin
  ListViewSort1.List.Clear;
  for I := 0 to SourceComponents.Count - 1 do
    LoadFromComponent(SourceComponents[I]);
  ListViewSort1.Refresh;
end;

procedure TFormKeyShortcuts.ListView1Data(Sender: TObject; Item: TListItem);
begin
  if Item.Index < ListViewSort1.List.Count then
    with TAction(ListViewSort1.List[Item.Index]) do begin
      Item.Caption := Caption;
      Item.ImageIndex := ImageIndex;
      Item.Data := TAction(ListViewSort1.List[Item.Index]);
      with Item.SubItems do begin
        if ActionList.Owner = MainForm then Add(SMainForm)
        else if ActionList.Owner is TDataModule then Add(SGlobal)
        else if ActionList.Owner is TForm then Add(TForm(ActionList.Owner).Caption)
        else Add(ActionList.Name);
        if ShortCut <> 0 then Add(ShortCutToText(ShortCut))
          else Add('');
      end;
    end;
end;

procedure TFormKeyShortcuts.ListView1KeyPress(Sender: TObject; var Key: char);
begin
  if Key = #13 then MenuItem1Click(Sender);
end;

function TFormKeyShortcuts.ListViewSort1CompareItem(Item1, Item2: TObject
  ): Integer;
begin
  Result := 0;
  if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
    with ListViewSort1 do begin
      if Column = 0 then Result := CompareString(TAction(Item1).Caption, TAction(Item2).Caption)
      else if Column = 2 then Result := CompareString(ShortCutToText(TAction(Item1).ShortCut),
        ShortCutToText(TAction(Item2).ShortCut));
    end;
    if ListViewSort1.Order = soDown then Result := -Result;
  end else Result := 0;
end;

procedure TFormKeyShortcuts.FormCreate(Sender: TObject);
begin
  SourceComponents := TObjectList<TComponent>.Create;
  SourceComponents.OwnsObjects := False;
end;

procedure TFormKeyShortcuts.FormDestroy(Sender: TObject);
begin
  FreeAndNil(SourceComponents);
end;

procedure TFormKeyShortcuts.MenuItem1Click(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then
    TAction(ListView1.Selected.Data).Execute;
end;

function TFormKeyShortcuts.GetImageList: TCustomImageList;
begin
  Result := ListView1.SmallImages;
end;

procedure TFormKeyShortcuts.SetImageList(AValue: TCustomImageList);
begin
  ListView1.SmallImages := AValue;
end;

procedure TFormKeyShortcuts.LoadFromComponent(C: TComponent);
var
  I: Integer;
begin
  if C is TActionList then
  with TActionList(C) do begin
    for I := 0 to ActionCount - 1 do
      if Actions[I] is TAction then
        ListViewSort1.List.Add(Actions[I]);
  end;
  for I := 0 to C.ComponentCount - 1 do
    LoadFromComponent(C.Components[I]);
end;

end.