unit u_shortcutseditor; {$I u_defines.inc} interface uses Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Menus, Graphics, ExtCtrls, LCLProc, ComCtrls, Buttons, LCLType, PropEdits, RTTIGrids, strutils, u_sharedres, u_observer, u_interfaces, u_common, u_writableComponent, u_dialogs, EditBtn; type TShortcutItem = class(TCollectionItem) strict private fIdentifier: string; fData: TShortcut; fDeclarator: IEditableShortCut; fIndexInDecl: integer; published property identifier: string read fIdentifier write fIdentifier; property data: TShortcut read fData write fData; public function combination: string; procedure assign(source: TPersistent); override; property declarator: IEditableShortCut read fDeclarator write fDeclarator; property indexInDecl: integer read fIndexInDecl write fIndexInDecl; end; TShortCutCollection = class(TWritableLfmTextComponent) private fItems: TCollection; procedure setItems(value: TCollection); function getCount: Integer; function getItem(index: Integer): TShortcutItem; published property items: TCollection read fItems write setItems; public constructor create(AOwner: TComponent); override; destructor destroy; override; procedure assign(source: TPersistent); override; // function findIdentifier(const identifier: string): boolean; function findShortcut(aShortcut: Word): TShortcutItem; // property count: Integer read getCount; property item[index: Integer]: TShortcutItem read getItem; default; end; TEditableShortcut = class(TPersistent) public value: TShortCut; published property shortcut: TShortCut read value write value; end; { TShortcutEditor } TShortcutEditor = class(TFrame, IEditableOptions) btnClear: TSpeedButton; btnEdit: TSpeedButton; Panel1: TPanel; fltItems: TTreeFilterEdit; Panel2: TPanel; propedit: TTIPropertyGrid; tree: TTreeView; procedure btnClearClick(Sender: TObject); procedure btnEditClick(Sender: TObject); function fltItemsFilterNode(ItemNode: TTreeNode; out Done: Boolean): Boolean; procedure shortcutCatcherExit(Sender: TObject); procedure shortcutCatcherMouseLeave(Sender: TObject); procedure propeditModified(Sender: TObject); procedure treeSelectionChanged(Sender: TObject); private fObservers: TEditableShortCutSubject; fShortcuts: TShortCutCollection; fBackup: TShortCutCollection; fHasChanged: boolean; propvalue: TEditableShortcut; fHasScaled: boolean; procedure updateScaling; function optionedWantCategory(): string; function optionedWantEditorKind: TOptionEditorKind; function optionedWantContainer: TPersistent; procedure optionedEvent(event: TOptionEditorEvent); function optionedOptionsModified: boolean; function findCategory(const aName: string; aData: Pointer): TTreeNode; function findCategory(const aShortcutItem: TShortcutItem): string; function sortCategories(Cat1, Cat2: TTreeNode): integer; procedure receiveShortcuts; procedure updateEditCtrls; procedure sendShortcuts; function anItemIsSelected: boolean; public constructor create(TheOwner: TComponent); override; destructor destroy; override; end; implementation {$R *.lfm} var ShortcutEditor: TShortcutEditor; {$REGION TShortCutCollection ---------------------------------------------------} function TShortcutItem.combination: string; begin result := ShortCutToText(fData); end; procedure TShortcutItem.assign(source: TPersistent); var src: TShortcutItem; begin if source is TShortcutItem then begin src := TShortcutItem(source); fData:= src.fData; fIdentifier:= src.fIdentifier; fDeclarator := src.fDeclarator; end else inherited; end; constructor TShortCutCollection.create(AOwner: TComponent); begin inherited; fItems := TCollection.Create(TShortcutItem); end; destructor TShortCutCollection.destroy; begin fItems.Free; inherited; end; procedure TShortCutCollection.assign(source: TPersistent); begin if source is TShortCutCollection then fItems.Assign(TShortCutCollection(source).fItems) else inherited; end; procedure TShortCutCollection.setItems(value: TCollection); begin fItems.Assign(value); end; function TShortCutCollection.getCount: Integer; begin exit(fItems.Count); end; function TShortCutCollection.getItem(index: Integer): TShortcutItem; begin exit(TShortcutItem(fItems.Items[index])); end; function TShortCutCollection.findIdentifier(const identifier: string): boolean; var i: integer; begin result := false; for i := 0 to count-1 do if item[i].identifier = identifier then exit(true); end; function TShortCutCollection.findShortcut(aShortcut: Word): TShortcutItem; var i: integer; s: TShortcutItem; begin result := nil; for i := 0 to count-1 do begin s := item[i]; if s.data = aShortcut then exit(s); end; end; {$ENDREGION} {$REGION Standard Comp/Object things -------------------------------------------} constructor TShortcutEditor.create(TheOwner: TComponent); begin inherited; propvalue := TEditableShortcut.Create; fObservers := TEditableShortCutSubject.create; fShortcuts := TShortCutCollection.create(self); fBackup := TShortCutCollection.create(self); EntitiesConnector.addObserver(self); propedit.TIObject := propvalue; propedit.PropertyEditorHook.AddHandlerModified(@propeditModified); end; destructor TShortcutEditor.destroy; begin propvalue.Free; fObservers.Free; inherited; end; procedure TShortcutEditor.updateScaling; begin if fHasScaled then exit; fHasScaled := true; case GetIconScaledSize of iss16: begin AssignPng(btnClear, 'CLEAN'); AssignPng(btnEdit, 'SHORTCUTS'); AssignPng(fltItems.Glyph, 'FILTER_CLEAR') end; iss24: begin AssignPng(btnClear, 'CLEAN24'); AssignPng(btnEdit, 'SHORTCUTS24'); AssignPng(fltItems.Glyph, 'FILTER_CLEAR24') end; iss32: begin AssignPng(btnClear, 'CLEAN32'); AssignPng(btnEdit, 'SHORTCUTS32'); AssignPng(fltItems.Glyph, 'FILTER_CLEAR32') end; end; panel2.Height:=scaleY(30, 96); propedit.DefaultItemHeight:= scaleY(26, 96); propedit.BuildPropertyList(); end; function TShortcutEditor.anItemIsSelected: boolean; begin result := true; if tree.Selected.isNil or tree.Selected.Level.equals(0) or tree.Selected.Data.isNil then result := false; end; {$ENDREGION} {$REGION IEditableOptions ----------------------------------------------------} function TShortcutEditor.optionedWantCategory(): string; begin exit('Shortcuts'); end; function TShortcutEditor.optionedWantEditorKind: TOptionEditorKind; begin exit(oekControl); end; function TShortcutEditor.optionedWantContainer: TPersistent; begin updateScaling; receiveShortcuts; exit(self); end; procedure TShortcutEditor.optionedEvent(event: TOptionEditorEvent); begin case event of oeeSelectCat: begin receiveShortcuts; fltItems.Text:=''; end; oeeCancel: begin fShortcuts.assign(fBackup); sendShortcuts; fHasChanged := false; end; oeeAccept: begin fBackup.assign(fShortcuts); sendShortcuts; fHasChanged := false; end; end; end; function TShortcutEditor.optionedOptionsModified: boolean; begin exit(fHasChanged); end; {$ENDREGION} {$REGION shortcut editor things ------------------------------------------------} procedure TShortcutEditor.treeSelectionChanged(Sender: TObject); begin updateEditCtrls; end; procedure TShortcutEditor.shortcutCatcherExit(Sender: TObject); begin updateEditCtrls; end; procedure TShortcutEditor.shortcutCatcherMouseLeave(Sender: TObject); begin updateEditCtrls; end; procedure TShortcutEditor.propeditModified(Sender: TObject); var i: integer; j: integer; s: TShortCut; d: TShortcutItem = nil; t: string; n: TTreeNode; o: TTreeNode; const m1 = 'warning, "%s" is already assigned in the "%s" category and it is not guaranteed to work properly'; m2 = 'warning, "%s" is already assigned in the same category to "%s". The new shortcut will be ignored'; begin if not anItemIsSelected then exit; s := propvalue.value; t := shortCutToText(s); if t.isEmpty then exit; // warn but accept a dup if already in another category for i:= 0 to tree.Items.Count-1 do begin n := tree.Items[i]; if n = tree.Selected.Parent then continue; for j := 0 to n.Count-1 do begin o := n.Items[j]; if o.Data.isNil then continue; if TShortcutItem(o.Data).data = s then begin dlgOkInfo(format(m1, [t, n.Text])); break; end; end; end; // warn and discard a dup if already in the same cat. for i:= 0 to tree.Selected.Parent.Count-1 do begin if i = tree.Selected.Index then continue; o := tree.Selected.Parent.Items[i]; if o.Data.isNil then continue; if TShortcutItem(o.Data).data = s then d := TShortcutItem(o.Data); end; if d.isNotNil then dlgOkInfo(format(m2,[t, d.identifier])) else if TShortcutItem(tree.Selected.Data).data <> s then begin TShortcutItem(tree.Selected.Data).data := s; fHasChanged := true; end; updateEditCtrls; end; procedure TShortcutEditor.btnClearClick(Sender: TObject); begin if not anItemIsSelected then exit; if TShortcutItem(tree.Selected.Data).data <> 0 then begin TShortcutItem(tree.Selected.Data).data := 0; fHasChanged := true; end; updateEditCtrls; end; procedure TShortcutEditor.btnEditClick(Sender: TObject); begin if not anItemIsSelected then exit; propedit.Rows[0].Editor.Edit; end; function TShortcutEditor.fltItemsFilterNode(ItemNode: TTreeNode; out Done: Boolean): Boolean; var s: TShortcutItem; b: boolean; begin if fltItems.Filter.isBlank then exit(true); // keep categories if ItemNode.Parent.isNil then exit(true); b := AnsiContainsText(ItemNode.Text, fltItems.Filter); if ItemNode.Data.isNil then exit(b); s := TShortcutItem(ItemNode.Data); result := AnsiContainsText(s.combination, fltItems.Filter) or b; end; procedure TShortcutEditor.updateEditCtrls; var shc: TShortcutItem; begin if not anItemIsSelected then exit; shc := TShortcutItem(tree.Selected.Data); if propvalue.value <> shc.data then begin propvalue.value := shc.data; propedit.BuildPropertyList; end; end; function TShortcutEditor.findCategory(const aName: string; aData: Pointer): TTreeNode; var i: integer; n: TTreeNode; begin result := nil; for i:= 0 to tree.Items.Count-1 do begin n := tree.Items[i]; if (n.Text = aName) and (n.Data = aData) then exit(n); end; end; function TShortcutEditor.findCategory(const aShortcutItem: TShortcutItem): string; var i: integer; j: integer; n: TTreeNode; begin result := ''; for i := 0 to tree.Items.Count-1 do begin n := tree.Items.Item[i]; for j:= 0 to n.Count-1 do if n.Items[j].Data = Pointer(aShortcutItem) then exit(n.Text); end; end; function TShortcutEditor.sortCategories(Cat1, Cat2: TTreeNode): integer; begin result := CompareText(Cat1.Text, Cat2.Text); end; procedure TShortcutEditor.receiveShortcuts; var i: integer; j: integer; o: IEditableShortCut; s: TShortcutItem; procedure addItem(constref item: u_interfaces.TEditableShortcut; const index: integer); var prt: TTreeNode; begin // root category if item.category.isEmpty or item.identifier.isEmpty then exit; prt := findCategory(item.category, o); if prt.isNil then prt := tree.Items.AddObject(nil, item.category, o); // item as child s := TShortcutItem(fShortcuts.items.Add); s.identifier := item.identifier; s.data := item.shortcut; s.declarator := o; s.indexInDecl := index; tree.Items.AddChildObject(prt, item.identifier, s); end; begin tree.BeginUpdate; tree.Items.Clear; fShortcuts.items.Clear; fBackup.items.Clear; for i:= 0 to fObservers.observersCount-1 do begin o := fObservers.observers[i] as IEditableShortCut; for j:= 0 to o.scedCount-1 do addItem(o.scedGetItem(j), j); end; tree.Items.SortTopLevelNodes(@sortCategories); tree.EndUpdate; fBackup.Assign(fShortcuts); end; procedure TShortcutEditor.sendShortcuts; var i: integer; s: TShortcutItem; d: IEditableShortCut = nil; c: string; n: u_interfaces.TEditableShortcut; begin for i := 0 to fShortcuts.count-1 do begin s := fShortcuts[i]; d := s.declarator; c := findCategory(s); if not assigned(d) or c.isEmpty() then continue; n.identifier:= s.identifier; n.category := c; n.shortcut := s.data; d.scedSetItem(s.indexInDecl, n); end; end; {$ENDREGION} initialization ShortcutEditor := TShortcutEditor.Create(nil); finalization ShortcutEditor.Free; end.