-
Notifications
You must be signed in to change notification settings - Fork 7
/
FormConfig.pas
1886 lines (1653 loc) · 80 KB
/
FormConfig.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{ CustomMenu
Copyright (C) 2022 Baz Cuda
https://github.com/BazzaCuda/CustomMenu
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
}
unit FormConfig;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, System.Generics.Collections,
CustomMenuCommon, System.ImageList, Vcl.ImgList, Vcl.ExtCtrls, WinAPI.CommCtrl,
Vcl.Buttons, Vcl.Imaging.pngimage, Vcl.Menus, VirtualTrees, WinAPI.ActiveX,
Vcl.Samples.Spin,
Clipbrd, WinAPI.ShlObj, Vcl.Mask;
type
TConfigForm = class(TForm)
imageList1: TImageList;
imageList2: TImageList;
backPanel: TPanel;
treeMenu: TPopupMenu;
treePanel: TPanel;
buttonPanel: TPanel;
btnMoveMenuItemUp: TSpeedButton;
btnMoveMenuItemDown: TSpeedButton;
btnDeleteMenuItem: TSpeedButton;
btnAddMenuItem: TSpeedButton;
btnMoveMenuItemLeft: TSpeedButton;
lblDragAndDrop: TLabel;
editPanel: TPanel;
iconBevel: TBevel;
btnSave: TButton;
btnSavedChanges: TSpeedButton;
btnSelectCommandDirectory: TButton;
btnSelectCommandFile: TButton;
btnSelectICOfile: TSpeedButton;
btnSelectIconFromDLLExe: TSpeedButton;
btnShowMenu: TButton;
CloseBtn: TButton;
comboRunType: TComboBox;
comboCommandCategories: TComboBox;
editCommand: TLabeledEdit;
editDirectory: TLabeledEdit;
editIconFile: TLabeledEdit;
editIconIx: TSpinEdit;
editName: TLabeledEdit;
editParams: TLabeledEdit;
editSubMenuName: TLabeledEdit;
lblAppWindow: TLabel;
lblDisabled: TLabel;
lblDragAndDropCommandFile: TLabel;
lblHasLUAshield: TLabel;
lblIconGroup: TLabel;
lblRunAsAdmin: TLabel;
lblSelectFromExeDLLetc: TLabel;
lblSelectICOfile: TLabel;
lblSeparatorAfter: TLabel;
LUAshieldIcon: TImage;
menuIcon: TImage;
topBevel: TBevel;
bottomBevel: TBevel;
vst: TVirtualStringTree;
ImageList3: TImageList;
checkboxPanel: TPanel;
lblisSubMenu: TLabel;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
btnIsSubMenu: TBitBtn;
btnSeparatorAfter: TBitBtn;
btnDisabled: TBitBtn;
btnHasLUAshield: TBitBtn;
btnRunAsAdmin: TBitBtn;
lblDragDropFolder: TLabel;
lblDragDropIconFile: TLabel;
FileOpenDialog: TFileOpenDialog;
lblBrowseCommand: TLabel;
lblBrowseDirectory: TLabel;
popupMenu: TPopupMenu;
btnCopyMenuItem: TSpeedButton;
lblCommandList: TLabel;
comboCommandList: TComboBox;
editHint: TLabeledEdit;
lblResizeTheWindow: TLabel;
separatorBevel: TBevel;
lblCommandCategories: TLabel;
lblAutoFill: TLabel;
btnSaveRegistry: TButton;
btnSavedRegistry: TSpeedButton;
lblWriteRegistry: TLabel;
lblIconIx: TLabel;
lblHelp: TLabel;
lblFeedback: TLabel;
procedure FormCreate(Sender: TObject);
procedure CloseBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormResize(Sender: TObject);
procedure vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vstGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);
procedure vstDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
procedure vstInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure vstFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure btnAddMenuItemClick(Sender: TObject);
procedure vstChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure editNameChange(Sender: TObject);
procedure btnMoveMenuItemLeftClick(Sender: TObject);
procedure btnMoveMenuItemUpClick(Sender: TObject);
procedure btnMoveMenuItemDownClick(Sender: TObject);
procedure vstKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure btnDeleteMenuItemClick(Sender: TObject);
procedure vstDragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure btnSelectCommandDirectoryClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure editCommandChange(Sender: TObject);
procedure comboRunTypeChange(Sender: TObject);
procedure editParamsChange(Sender: TObject);
procedure editDirectoryChange(Sender: TObject);
procedure editIconFileChange(Sender: TObject);
procedure editIconIxChange(Sender: TObject);
procedure btnSeparatorAfterClick(Sender: TObject);
procedure btnDisabledClick(Sender: TObject);
procedure btnHasLUAshieldClick(Sender: TObject);
procedure btnRunAsAdminClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure WMDropFiles(var msg: TWMDropFiles); message WM_DROPFILES;
procedure btnSelectCommandFileClick(Sender: TObject);
procedure btnSelectICOfileClick(Sender: TObject);
procedure btnSelectIconFromDLLExeClick(Sender: TObject);
procedure btnShowMenuClick(Sender: TObject);
procedure btnCopyMenuItemClick(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure comboCommandListSelect(Sender: TObject);
procedure comboCommandCategoriesSelect(Sender: TObject);
procedure btnSaveRegistryClick(Sender: TObject);
procedure editHintChange(Sender: TObject);
procedure lblHelpClick(Sender: TObject);
procedure lblFeedbackClick(Sender: TObject);
private
itemData: TList<TItemData>;
FDropPoint: TPoint;
FImageIx: integer;
FInitialHeight: integer;
FLastFolder: string;
FSavedTree: TStringList;
FTreeClick: boolean;
FDragDescriptionFormat: cardinal;
function actionThisIcon(iconFile: string; iconIx: integer): boolean;
function capitalize(const aString: string): string;
function checkIfStillSubMenu(aNode: PVirtualNode): boolean;
function checkNodeParentage: boolean;
function checkSaves: boolean;
function enableSaveButton(enabled: boolean): boolean;
function enableSaveRegistryButton(enabled: boolean): boolean;
function enableShowMenuButton(enabled: boolean): boolean;
function getCleanCaption: string;
function getDirtyCaption: string;
function getStdIconIx(iconIx: integer): integer;
function populateBoxesFromItemData(id: PItemData): boolean;
function populateBoxesFromCommand(cmdFilePath: string): boolean;
function populateBoxesFromLnk(lnkFilePath: string): boolean;
function populateCommandCategories: boolean;
function populateCommandList(commands: TArray<string>): boolean;
procedure saveNode(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
function saveTree(vst: TVirtualStringTree): boolean;
procedure saveNodeToRegistry(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
function saveToRegistry: boolean;
function saveTreeToRegistry(vst: TVirtualStringTree): boolean;
function selData: PItemData;
function setDragHint(DataObject: IDataObject; const Value: string; Effect: Integer): boolean;
function setWindowCaption: boolean;
function updateMenuIcon: boolean;
//========== VCL Event Handlers ===========
protected
procedure CreateParams(var Params: TCreateParams); override;
public
end;
function configFormOpen: boolean;
function showConfigForm: boolean;
function shutConfigForm: boolean;
function enableConfigForm: boolean;
implementation
uses _debugWindow, VirtualTrees.Types, WinAPI.ShellAPI, system.win.comobj, FormIconExplorer, FormCustomMenu, System.Win.Registry, winShell, runElevatedSupport,
shellFoldersDef, mmcDef, mmcServerDef, cpl1Def, cpl2Def, runDll32Def, msSettingsDef, shellGuidsDef, system.strUtils;
var configForm: TConfigForm;
FCurrentIx: integer = -1; // when loading all the data and the icons, FCurrentIx and all "for i" loop variables will match for all the
// indexes of itemData, imageList1 and imageList3.
function backupRegistryKey: boolean;
// rc doesn't actually tell us if the registry key was successfully exported, only that reg.exe was run.
var
regFileName: string;
regFileIx: integer;
begin
regFileIx := 0;
regFileName := getExePath + 'HKLM_desktopBackground.reg.bak';
case fileExists(regFileName) of TRUE: repeat inc(regFileIx);
regFileName := getExePath + format('HKLM_desktopBackground(%d).reg.bak', [regFileIx]);
until NOT fileExists(regFileName); end;
var rc := shellExecute(0, 'open', 'reg.exe', PWideChar('EXPORT HKLM\' + CM_REGISTRY_KEY + ' ' + regFileName), PWideChar(getExePath), SW_HIDE);
case rc > 32 of FALSE: rc := shellExecute(0, 'runas', 'reg.exe', PWideChar('EXPORT HKLM\' + CM_REGISTRY_KEY + ' ' + regFileName), PWideChar(getExePath), SW_HIDE); end;
case rc > 32 of FALSE: showMessage('Unable to backup the registry key'#13#10'Save to registry aborted'); end;
sleep(3000); // need to give reg.exe time to run and create the backup file. Not a particularly sound way of doing this.
result := (rc > 32) and fileExists(regFileName); // well, we backed-up something!
end;
function buildTreeFromItemData(itemData: TList<TItemData>; vst: TVirtualStringTree): boolean;
// Everything is added as a child of subMenuHeader. The trick is to maintain the value
// of subMenuHeader correctly. When it's NIL, the new node gets added as a child of the
// root node. When we're in a submenu and the submenuName changes, crawl back up the
// levels until the matching subMenuHeader is located.
var
newNode: PVirtualNode;
subMenuHeader: PVirtualNode;
subMenuHeaderData: PItemData;
function resetSubLevel: boolean;
begin
newNode := NIL; subMenuHeader := NIL;
end;
begin
case itemData.count = 0 of TRUE: EXIT; end;
resetSubLevel;
for var i: integer := 0 to itemData.Count - 1 do begin
case (not itemData[i].idSubMenu) and (itemData[i].idSubMenuName = '') of TRUE: resetSubLevel; end; // it's a root level item: not a submenu itself and not a sub item
case subMenuHeader <> NIL of TRUE: begin subMenuHeaderData := subMenuHeader.getData; end;end;
if subMenuHeader <> NIL then
while (subMenuHeader <> NIL) and (itemData[i].idSubMenuName <> subMenuHeaderData.idName) do begin subMenuHeader := subMenuHeader.parent; // the subMenuName doesn't match the subMenuHeader
subMenuHeaderData := subMenuHeader.getData; end; // back-up until it does
FCurrentIx := i; // signal to initNode that it can populate its TItemData from TList<TitemData> - specifically itemData[FCurrentIx]
newNode := vst.addChild(subMenuHeader);
case itemData[i].idSubMenu of TRUE: subMenuHeader := newNode; end; // the newNode is now the subMenuHeader
end;
FCurrentIx := -1; // signal to initNode that from now on there's no pre-existing TItemData for new nodes
end;
function buttonChecked(button: TBitBtn): boolean;
// mimics "if checkBox.checked..."
begin
result := button.imageIndex = IL2_CHECKED;
end;
function configFormOpen: boolean;
begin
result := configForm <> NIL;
end;
function enableConfigForm: boolean;
begin
case configForm = NIL of TRUE: EXIT; end;
enableWindow(configForm.handle, TRUE);
setWindowPos(configForm.handle, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
end;
function freeItemData(var itemData: TList<TItemData>): boolean;
begin
case itemData = NIL of TRUE: EXIT; end;
itemDataClear(itemData); itemData.clear; itemData.free; itemData := NIL;
end;
function loadMenuDataFromINI(iniFilePath: string; itemData: TList<TItemData>): boolean;
// populate itemData: TList<TItemData> from the INI file.
var
i: integer;
iniFile: TStringList;
function iniClause(clauseName: string): string;
var
posClause: integer;
posEquals: integer;
posDelim: integer;
begin
result := '';
posClause := pos(lowerCase(clauseName) + '=', lowerCase(iniFile[i]));
case posClause = 0 of TRUE: EXIT; end;
posEquals := pos('=', iniFile[i], posClause);
case posEquals = 0 of TRUE: EXIT; end;
posDelim := pos(';', iniFile[i], posEquals);
case posDelim = 0 of TRUE: EXIT; end;
result := copy(iniFile[i], posEquals + 1, posDelim - posEquals - 1);
end;
begin
result := FALSE;
case fileExists(iniFilePath) of FALSE: EXIT; end;
iniFile := TStringlist.create;
try
iniFile.loadFromFile(iniFilePath);
case iniFile.count = 0 of TRUE: EXIT; end;
for i := 0 to iniFile.count - 1 do begin
case trim(iniFile[i]) = '' of TRUE: CONTINUE; end; // ignore blank lines in ini file
var id: TItemData;
id.idName := iniClause('name');
id.idSubMenu := lowerCase(iniClause('subMenu')) = 'yes';
id.idSubMenuName := iniClause('subMenuName');
id.idSeparatorAfter := lowerCase(iniClause('separatorAfter')) = 'yes';
id.idHasLUAShield := lowerCase(iniClause('hasLUAshield')) = 'yes';
id.idIconFile := iconFileFromIconEntry(iniClause('icon'));
id.idIconIx := iconIxFromIconEntry(iniClause('icon'));
id.idCommand := iniClause('command');
id.idParams := iniClause('params');
id.idDirectory := iniClause('directory');
id.idRunType := iniClause('runType');
id.idRunAsAdmin := lowerCase(iniClause('runAsAdmin')) = 'yes';
id.idHint := iniClause('hint');
id.idDisabled := trim(iniFile[i])[1] = ':';
itemData.Add(id);
id := default(TItemData); // clear all the fields
end;
finally
iniFile.free;
result := TRUE;
end;
end;
function reverseBtnChecked(sender: TObject): boolean;
// mimic a checkBox click
begin
with sender as TBitBtn do
case imageIndex of
-1: imageIndex := IL2_CHECKED;
IL2_CHECKED: imageIndex := -1;
end;
end;
function setButtonChecked(button: TBitBtn; checked: boolean): boolean;
// mimic checkBox.checked := <whatever>
begin
case checked of TRUE: button.imageIndex := IL2_CHECKED;
FALSE: button.imageIndex := -1; end;
end;
function showConfigForm: boolean;
begin
case configForm <> NIL of TRUE: EXIT; end; // it's already being shown; re-enable it.
case configForm = NIL of TRUE: configForm := TconfigForm.create(NIL); end;
enableHook(FALSE);
try
configForm.vst.RootNodeCount := 0;
// case fileExists(getIniFileName) of FALSE: createMiniIni; end; // moved to .dpr file
case loadMenuDataFromINI(getINIFileName, configForm.itemData) of FALSE: configForm.vst.AddChild(NIL); end; // give them something to get started.
var defaultIcon: TIcon := TIcon.create;
try
configForm.imageList2.GetIcon(IL2_UNIVERSAL, defaultIcon); // get a copy of universal.ico - the default icon for menu items that don't have one
loadIcons(configForm.itemData, configForm.imageList1, defaultIcon); // imageList1 holds the 16x16 icons shown in the vst "menu"
loadIcons(configForm.itemData, configForm.imageList3, defaultIcon, 32); // imageList3 is used to display 32x32 versions in the menuIcon: TImage;
finally
defaultIcon.free;
end;
buildTreeFromItemData(configForm.itemData, configForm.vst);
freeItemData(configForm.itemData); // with all the nodes initialized, we can no longer need the TList<TItemData>
configForm.vst.fullExpand;
configForm.btnSave.enabled := FALSE;
configForm.btnSavedChanges.visible := FALSE;
enableTrayExit(FALSE); // force the user to close the config form before closing the app
configForm.showModal; // formClose is called when modalResult is set.
finally
enableHook;
enableTrayExit(TRUE);
GREFRESH := TRUE;
configForm := NIL; // formClose does a caFree;
end;
end;
function shutConfigForm: boolean; // force close from the EXIT tray icon menu item
begin
case configForm <> NIL of TRUE: begin
configForm.close; // does a caFree;
configForm := NIL; end;end;
end;
//========== FORM FUNCTIONS ==========
function TConfigForm.getCleanCaption: string;
begin
result := getINIFileName + ' - ' + CM_APP_NAME + ' ' + getFileVersion('', 'v%d.%d.%d');
case isRunningAsAdmin of TRUE: result := result + ' [Admin]'; end;
end;
function TConfigForm.getDirtyCaption: string;
begin
result := '*' + getCleanCaption;
end;
function TConfigForm.getStdIconIx(iconIx: integer): integer;
// get a copy of one of the standard icons, e.g. IL2_UNIVERSAl
// add the copy to both image lists
// return the new index
begin
var defaultIcon: TIcon := TIcon.create;
try
imageList2.GetIcon(iconIx, defaultIcon); // get a copy of the required icon
result := imageList1.AddIcon(defaultIcon); // add it to the end of both image lists
imageList3.AddIcon(defaultIcon);
finally
defaultIcon.free;
end;
end;
procedure TConfigForm.lblFeedbackClick(Sender: TObject);
begin
shellExecute(0, 'open', 'https://github.com/BazzaCuda/CustomMenu/discussions/', '', '', SW_SHOW);
end;
procedure TConfigForm.lblHelpClick(Sender: TObject);
begin
shellExecute(0, 'open', 'https://github.com/BazzaCuda/CustomMenu/wiki/Getting-Started', '', '', SW_SHOW);
end;
function TConfigForm.populateBoxesFromCommand(cmdFilePath: string): boolean;
begin
case trim(cmdFilePath) = '' of TRUE: EXIT; end;
var vExt := lowerCase(extractFileExt(cmdFilePath));
case (trim(editIconFile.text) = '') of TRUE: editIconFile.text := cmdFilePath; end;
case (trim(editName.text) = '') or (editName.text = CM_NEW_ITEM_NAME) of TRUE: editName.text := capitalize(getFileNameWithoutExt(cmdFilePath)); end;
case (trim(editDirectory.text) = '') of TRUE: editDirectory.text := includeTrailingBackslash(extractFilePath(cmdFilePath)); end;
case editDirectory.text = '\' of TRUE: editDirectory.text := ''; end;
end;
function TConfigForm.populateBoxesFromItemData(id: PItemData): boolean;
// if the underlying data has changed, the UI must display the up-to-date info
begin
editName.text := id.idName;
setButtonChecked(btnIsSubMenu, id.idSubMenu);
editSubMenuName.text := id.idSubMenuName;
setButtonChecked(btnSeparatorAfter, id.idSeparatorAfter);
setButtonChecked(btnHasLUAshield, id.idHasLUAShield);
editIconFile.text := id.idIconFile;
editIconIx.value := id.idIconIx;
editCommand.text := id.idCommand;
editParams.text := id.idParams;
editDirectory.text := id.idDirectory;
comboRunType.ItemIndex := comboRunType.items.indexOf(id.idRunType);
editHint.text := id.idHint;
case comboRunType.itemIndex = -1 of TRUE: comboRunType.itemIndex := 0; end; // default to Normal
setButtonChecked(btnRunAsAdmin, id.idRunAsAdmin);
setButtonChecked(btnDisabled, id.idDisabled);
end;
function TConfigForm.populateBoxesFromLnk(lnkFilePath: string): boolean;
// set the boxes directly so that it triggers their respective change events and enables the save buton
var
linkInfo: TShellLinkInfo;
begin
getShellLinkInfo(lnkFilePath, linkInfo);
case (trim(editName.text) = '') or (editName.text = CM_NEW_ITEM_NAME) of TRUE: editName.text := capitalize(getFileNameWithoutExt(lnkFilePath)); end;
case (linkInfo.params = '') of FALSE: begin editParams.text := linkInfo.params; end;end;
case isShiftKeyDown of TRUE: begin // get relative paths to everything;
linkInfo.targetFile := extractRelativePath(getExePath, linkInfo.targetFile);
linkInfo.workingDir := extractRelativePath(getExePath, linkInfo.workingDir);
linkInfo.iconFile := extractRelativePath(getExePath, linkInfo.iconFile); end;end;
editCommand.text := linkInfo.targetFile;
editDirectory.text := includeTrailingBackslash(linkInfo.workingDir);
// if there's an icon file in the .lnk, use it. If not, and the user hasn't chosen an icon file yet, try the targetFile as the icon source
case (linkInfo.iconFile = '') of FALSE: begin editIconFile.text := linkInfo.iconFile; editIconIx.value := linkInfo.iconIx; end;
TRUE: case (trim(editIconFile.text) = '') of TRUE: editIconFile.text := linkInfo.targetFile; end;end;
comboRunType.itemIndex := linkInfo.showCmd - 1; // doesn't trigger the onChange event
comboRunTypeChange(NIL); // so we do it manually.
end;
function TConfigForm.populateCommandList(commands: TArray<string>): boolean;
begin
for var i := 0 to high(commands) do
comboCommandList.items.add(commands[i]);
end;
//========== Save Tree to INI ==========
var
vTabs: string;
vSubMenuHeader: PVirtualNode;
vSubMenuHeaderData: PItemData;
vSubMenu: string;
vSeparatorAfterSubMenu: boolean;
function resetSubLevel: boolean;
begin
vTabs := '';
vSubMenuHeader := NIL;
vSubMenu := '';
end;
function outstandingSeparator(savedTree: TStringList): boolean;
begin
case vSeparatorAfterSubMenu of TRUE: begin
savedTree.add('');
vSeparatorAfterSubMenu := FALSE; end;end;
end;
procedure TConfigForm.saveNode(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
// Writes out the INI file indenting the submenus and sub-submenus and adding the separators as blank lines where applicable.
// The logic is adapted from buildTreeFromItemData and I never want to have to write either of them again!
// It was more Zen than anything else :D
var
id: PItemData;
lineOut: string;
begin
id := Sender.GetNodeData(Node);
case (NOT id.idSubMenu) and (id.idSubMenuName = '') of TRUE: begin // it's a root level item: not a submenu itself and not a sub item
resetSubLevel;
outstandingSeparator(FSavedTree); end;end;
case vSubMenuHeader <> NIL of TRUE: begin vSubMenuHeaderData := vSubMenuHeader.getData; end;end;
case vSubMenuHeader <> NIL of TRUE:
while (vSubMenuHeader <> NIL) and (id.idSubMenuName <> vSubMenuHeaderData.idName) do begin vSubMenuHeader := vSubMenuHeader.parent; // the subMenuName doesn't match the subMenuHeader
vSubMenuHeaderData := vSubMenuHeader.getData; // back-up until it does
vSubMenu := vSubMenuHeaderData.idName;
case length(vTabs) > 0 of TRUE: delete(vTabs, 1, 1); end;
outstandingSeparator(FSavedTree); end;end;
case (id.idSubMenuName <> '') and (id.idSubMenuName <> vSubMenu) of TRUE: begin
vSubMenu := id.idSubMenuName;
vTabs := vTabs + #9; end;end;
lineOut := vTabs;
case id.idDisabled of TRUE: lineOut := lineOut + ':'; end;
case id.idName <> '' of TRUE: lineOut := lineOut + format('name=%s;', [id.idName]); end;
case id.idSubMenu of TRUE: lineOut := lineOut + 'subMenu=yes;'; end;
case id.idSubMenuName <> '' of TRUE: lineOut := lineOut + format('subMenuName=%s;', [id.idSubMenuName]); end;
case id.idSeparatorAfter of TRUE: lineOut := lineOut + 'separatorAfter=yes;'; end;
case id.idHasLUAShield of TRUE: lineOut := lineOut + 'hasLUAshield=yes;'; end;
case id.idIconFile <> '' of TRUE: lineOut := lineOut + format('icon=%s,%d;', [id.idIconFile, id.idIconIx]); end;
case id.idCommand <> '' of TRUE: lineOut := lineOut + format('command=%s;', [id.idCommand]); end;
case id.idParams <> '' of TRUE: lineOut := lineOut + format('params=%s;', [id.idParams]); end;
case id.idDirectory <> '' of TRUE: lineOut := lineOut + format('directory=%s;', [id.idDirectory]); end;
case id.idRunType <> '' of TRUE: lineOut := lineOut + format('runType=%s;', [id.idRunType]); end;
case id.idHint <> '' of TRUE: lineOut := lineOut + format('hint=%s;', [id.idHint]); end;
case id.idRunAsAdmin of TRUE: lineOut := lineOut + 'runAsAdmin=yes;'; end;
FSavedTree.add(lineOut);
case (id.idSubMenu) and (id.idCommand <> 'browse') of TRUE: vSubMenuHeader := node; end; // the newNode is now the subMenuHeader;
case id.idSeparatorAfter of TRUE: case NOT id.idSubMenu of TRUE: FSavedTree.add('');
FALSE: vSeparatorAfterSubMenu := TRUE; end;end;
end;
function TConfigForm.saveTree(vst: TVirtualStringTree): boolean;
begin
FSavedTree := TStringList.create;
vSeparatorAfterSubMenu := FALSE;
resetSubLevel;
try
vst.iterateSubtree(NIL, saveNode, NIL);
finally
FSavedTree.saveToFile(getINIFileName);
FSavedTree.free;
end;
end;
//\\========== Save Tree to INI ==========\\
//========== Save Tree to Registry ==========
var
reg: TRegistry;
vKey: string;
function resetRegSubLevel: boolean;
begin
vKey := CM_REGISTRY_KEY;
vSubMenuHeader := NIL;
vSubMenu := '';
end;
procedure TConfigForm.saveNodeToRegistry(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
// Writes to HKLM\SOFTWARE\Classes\DesktopBackground\Shell\
// The logic is adapted from saveNode and I never wanted to have to write another one again....ever!....and yet, here I am!
// Sometimes, an idea for new functionality is just too good to ignore :D
var
id: PItemData;
function menuIx(absIx: integer; reverse: boolean = TRUE): integer;
// POSITION = TOP. Main menu items must be named in reverse alphanumeric order under the HKLM\SOFTWARE\Classes\DesktopBackground\Shell registry key
// but sub-menu items have to be named in alphanumeric order. Thanks Microsoft!
begin
case reverse of TRUE: result := (vst.totalCount - 1) - absIx;
FALSE: result := absIx; end;
end;
function rootItemKey(aKey: string): string;
// vKey + 123_ + idName;
begin
result := format('%s\%.3d_%s', [aKey, menuIx(vst.absoluteIndex(node)), id.idName]);
end;
function subItemKey(aKey: string): string;
// vKey + \Shell\ + 123_ + idName;
begin
result := format('%s\shell\%.3d_%s', [aKey, menuIx(vst.absoluteIndex(node), FALSE), id.idName]); // *** // POSITION = TOP, but submenu items have to be named in alphanumeric order!! // *** //
end;
function noShell: boolean;
begin
result := vKey.subString(length(vKey) - 6, 6) <> '\shell';
end;
function subMenuKey(aKey: string): string;
// vKey + 123_ + idName;
begin
var vShell := '';
case noShell of TRUE: vShell := '\shell'; end; // subMenu keys must have a \shell parent key
result := format('%s%s\%.3d_%s', [aKey, vShell, menuIx(vst.absoluteIndex(node)), id.idName]); {experimental: add \shell if required}
end;
function writeStdValues: boolean;
begin
reg.writeString('MUIVerb', id.idName);
case id.idIconFile <> '' of TRUE: reg.writeString('icon', id.idIconFile + ',' + intToStr(id.idIconIx)); end;
case id.idHasLUAShield of TRUE: reg.writeString('HasLUAshield', ''); end;
case id.idSeparatorAfter of TRUE: reg.writeString('SeparatorAfter', ''); end;
{ // *** // POSITION = TOP means main menu items have to be named in reverse alphanumeric order in the registry,
otherwise the Windows desktop menu displays upsidedown! // *** // }
reg.writeString('Position', 'Top');
// Make sure our menu items are separated from any items that Windows adds to the desktop context menu
case vst.absoluteIndex(node) = 0 of TRUE: reg.writeString('SeparatorBefore', ''); end;
case vst.absoluteIndex(node) = vst.TotalCount - 1 of TRUE: reg.writeString('SeparatorAfter', ''); end;
end;
function notBrowse: boolean;
begin
result := id.idCommand <> 'browse';
end;
function removeShell: boolean;
begin
case vKey.subString(length(vKey) - 6, 6) = '\shell' of TRUE: setLength(vKey, length(vKey) - 6); end;
end;
begin
id := Sender.GetNodeData(Node);
case id.idDisabled of TRUE: EXIT; end;
case (NOT id.idSubMenu) and (id.idSubMenuName = '') of TRUE: resetRegSubLevel; end; // it's a root level item: not a submenu itself and not a sub item
case vSubMenuHeader <> NIL of TRUE: begin vSubMenuHeaderData := vSubMenuHeader.getData; end;end;
case vSubMenuHeader <> NIL of TRUE:
while (vSubMenuHeader <> NIL) and (id.idSubMenuName <> vSubMenuHeaderData.idName) do begin vSubMenuHeader := vSubMenuHeader.parent; // the subMenuName doesn't match the subMenuHeader
vSubMenuHeaderData := vSubMenuHeader.getData; // back-up until it does
vSubMenu := vSubMenuHeaderData.idName;
{ this is why the const doesn't have the trailing \ }
case length(vKey) > length(CM_REGISTRY_KEY) of TRUE: delete(vKey, lastDelimiter('\', vKey), 255); end;
case length(vKey) > length(CM_REGISTRY_KEY) of TRUE: removeShell; end;
end;end;
case (id.idSubMenuName <> '') and (id.idSubMenuName <> vSubMenu) of TRUE: begin vSubMenu := id.idSubMenuName;
var vShell := '';
case noShell of TRUE: vShell := '\shell'; end; // can't have a submenu key without a parent \shell key
{ don't change the next statement; it's the key to everything! }
vKey := vKey + vShell + '\' + format('%.3d_', [menuIx(vst.absoluteIndex(node) - 1)]) + id.idSubMenuName; end;end;
case id.idSubMenu of TRUE: begin case reg.openKey(subMenuKey(vKey), TRUE) of TRUE: begin writeStdValues;
reg.writeString('SubCommands', '');
reg.closeKey; end;end;end;end;
case (id.idSubMenuName <> '') and NOT id.idSubMenu of TRUE: begin
reg.createKey(subItemKey(vKey));
case reg.openKey(subItemKey(vKey), TRUE) of TRUE: begin writeStdValues;
reg.closeKey; end;end;
case reg.openKey(subItemKey(vKey) + '\Command\', TRUE) of TRUE: begin reg.writeString('', id.idCommand + ' ' + id.idParams);
reg.closeKey; end;end;end;end;
case (id.idSubMenuName = '') and NOT id.idSubMenu of TRUE: begin // root level items which aren't subMenus
reg.createKey(rootItemKey(vKey));
case reg.openKey(rootItemKey(vKey), TRUE) of TRUE: begin writeStdValues;
reg.closeKey; end;end;
case reg.openKey(rootItemKey(vKey) + '\Command\', TRUE) of TRUE: begin reg.writeString('', id.idCommand + ' ' + id.idParams);
reg.closeKey; end;end;end;end;
case (id.idSubMenu) and notBrowse of TRUE: vSubMenuHeader := node; end; // the newNode is now the subMenuHeader; // browses aren't real submenu headers.
end;
function TConfigForm.saveTreeToRegistry(vst: TVirtualStringTree): boolean;
begin
result := FALSE;
reg := TRegistry.create(KEY_ALL_ACCESS);
try
reg.RootKey := HKEY_LOCAL_MACHINE;
case reg.OpenKey(CM_REGISTRY_KEY, TRUE) of FALSE: begin showMessage('Unable to open the registry key for writing'); EXIT; end;end;
reg.closeKey;
{case} reg.deleteKey(CM_REGISTRY_KEY) {of FALSE: begin showMessage('Unable to delete the registry key'); EXIT; end;end}; // partial deletes may be good enough. It's for the user to test.
resetSubLevel;
vst.iterateSubtree(NIL, saveNodeToRegistry, NIL);
result := TRUE;
finally
reg.closeKey;
reg.free;
end;
end;
function TConfigForm.saveToRegistry: boolean;
begin
result := FALSE;
screen.cursor := crHourGlass;
try
case backupRegistryKey of TRUE: result := saveTreeToRegistry(vst); end;
finally
screen.cursor := crDefault;
end;
end;
//\\========== Save Tree to Registry ==========\\
function TConfigForm.updateMenuIcon: boolean;
// If the 32x32 icon to be displayed is different from the one currently displayed
// get it from imageList3 and update the menuIcon TImage
begin
var sel: PVirtualNode := vst.GetFirstSelected;
case sel = NIL of TRUE: EXIT; end;
var id: PItemData := sel.getData;
case id = NIL of TRUE: EXIT; end;
case id.idImageIx = FImageIx of TRUE: EXIT; end; // stops the image from flashing everytime a node is selected.
menuIcon.Picture.Icon := NIL;
menuIcon.Refresh;
imageList3.GetIcon(id.idImageIx, menuIcon.Picture.Icon); // update menuIcon
menuIcon.Refresh;
FImageIx := id.idImageIx;
end;
{$R *.dfm}
//========== VCL Event Handlers ===========
procedure TConfigForm.btnAddMenuItemClick(Sender: TObject);
var
sel: PVirtualNode;
newNode: PVirtualNode;
begin
case vst.TotalCount = 0 of TRUE: sel := NIL;
FALSE: begin
sel := vst.GetFirstSelected;
case sel = NIL of TRUE: EXIT; end;end;end;
newNode := vst.InsertNode(sel, amInsertAfter);
vst.selected[sel] := FALSE;
vst.Selected[newNode] := TRUE;
vst.fullExpand;
editName.setFocus;
enableSaveButton(TRUE);
end;
procedure TConfigForm.btnDeleteMenuItemClick(Sender: TObject);
begin
case vst.totalCount = 0 of TRUE: EXIT; end;
var selText := vst.Text[vst.getFirstSelected, 0];
var msg := 'Are you sure you want to delete this menu item:'#13#10'"' + selText + '" ';
case vst.getFirstSelected.childCount > 0 of TRUE: msg := msg + #13#10' AND all of its subMenu items'; end;
msg := msg + '?';
case vcl.dialogs.messageDlg(msg, mtWarning, [mbYes, mbNo], 0, mbNo) = mrYes of TRUE: vst.DeleteNode(vst.getFirstSelected); end;
checkNodeParentage; // and populateBoxesFromItemData() and updateMenuIcon()
enableSaveButton(TRUE);
end;
function TConfigForm.selData: PItemData;
begin
case vst.getFirstSelected = NIL of TRUE: result := NIL;
FALSE: result := vst.getFirstSelected.getData; end;
end;
function TConfigForm.setDragHint(DataObject: IDataObject; const Value: string; Effect: Integer): boolean;
// https://stackoverflow.com/questions/47395267/how-to-change-drop-hint-delphi-application-when-doing-drag-drop-from-explorer
var
FormatEtc: TFormatEtc;
Medium: TStgMedium;
Data: Pointer;
Descr: DROPDESCRIPTION;
s: WideString;
begin
ZeroMemory(@Descr, SizeOf(DROPDESCRIPTION));
{Do not set Descr.&type to DROPIMAGE_INVALID - this value ignore any custom hint}
{use same image as dropeffect type}
Descr.&type := DROPIMAGE_LABEL;
case Effect of
DROPEFFECT_NONE: Descr.&type := DROPIMAGE_NONE;
DROPEFFECT_COPY: Descr.&type := DROPIMAGE_COPY;
DROPEFFECT_MOVE: Descr.&type := DROPIMAGE_MOVE;
DROPEFFECT_LINK: Descr.&type := DROPIMAGE_LINK;
end;
{format message for system}
if Length(Value) <= MAX_PATH then
begin
Move(Value[1], Descr.szMessage[0], Length(Value) * SizeOf(WideChar));
Descr.szInsert := '';
end
else
begin
s := Copy(Value, 1, MAX_PATH - 2) + '%1';
Move(s[1], Descr.szMessage[0], Length(s) * SizeOf(WideChar));
s := Copy(Value, MAX_PATH - 1, MAX_PATH);
Move(s[1], Descr.szInsert[0], Length(s) * SizeOf(WideChar));
end;
{prepare structures to set DROPDESCRIPTION data}
FormatEtc.cfFormat := FDragDescriptionFormat; {registered clipboard format}
FormatEtc.ptd := nil;
FormatEtc.dwAspect := DVASPECT_CONTENT;
FormatEtc.lindex := -1;
FormatEtc.tymed := TYMED_HGLOBAL;
ZeroMemory(@Medium, SizeOf(TStgMedium));
Medium.tymed := TYMED_HGLOBAL;
Medium.HGlobal := GlobalAlloc(GHND or GMEM_SHARE, SizeOf(DROPDESCRIPTION));
Data := GlobalLock(Medium.HGlobal);
Move(Descr, Data^, SizeOf(DROPDESCRIPTION));
GlobalUnlock(Medium.HGlobal);
DataObject.SetData(FormatEtc, Medium, True);
end;
function TConfigForm.setWindowCaption: boolean;
begin
case btnSave.enabled of TRUE: caption := getDirtyCaption;
FALSE: caption := getCleanCaption; end;
end;
procedure TConfigForm.btnCopyMenuItemClick(Sender: TObject);
begin
case selData = NIL of TRUE: EXIT; end;
var id1 := selData;
var sel := vst.getFirstSelected;
var newNode := vst.InsertNode(sel, amInsertAfter);
var id2: PItemData := newNode.getData;
id2.idName := id1.idName;
id2.idSubMenu := id1.idSubMenu;
id2.idSubMenuName := id1.idSubMenuName;
id2.idSeparatorAfter := id1.idSeparatorAfter;
id2.idHasLUAShield := id1.idHasLUAShield;
id2.idIconFile := id1.idIconFile;
id2.idIconIx := id1.idIconIx;
id2.idCommand := id1.idCommand;
id2.idParams := id1.idParams;
id2.idDirectory := id1.idDirectory;
id2.idRunType := id1.idRunType;
id2.idRunAsAdmin := id1.idRunAsAdmin;
id2.idHint := id1.idHint;
id2.idDisabled := id1.idDisabled;
id2.idImageIx := id1.idImageIx;
id2.idPrevImageIx := id1.idPrevImageIx;
vst.selected[sel] := FALSE;
vst.Selected[newNode] := TRUE;
vst.fullExpand;
editName.setFocus;
enableSaveButton(TRUE);
end;
procedure TConfigForm.btnDisabledClick(Sender: TObject);
begin
reverseBtnChecked(sender);
case selData = NIL of TRUE: EXIT; end;
var id := selData;
enableSaveButton(btnSave.enabled or (id.idDisabled <> buttonChecked(btnDisabled))); // has the value changed?
id.idDisabled := buttonChecked(btnDisabled);
end;
procedure TConfigForm.btnHasLUAshieldClick(Sender: TObject);
// loadIcons() will try to load the icon specified in idIconFile/idIconix, or set the default IL2_UNIVERSAL icon.
// If idHasLUAShield, initNode() will override this icon, putting it in idPrevImageIx.
// As such, if the user unchecks btnHasLUAshield in the UI, there's a readymade icon in idPrevImageIx to take its place.
// Or, if the user changes it to another icon before then checking and unchecking btnHasLUAshield, that icon will be the
// one that gets restored.
begin
reverseBtnChecked(sender);
case selData = NIL of TRUE: EXIT; end;
var id := selData;
enableSaveButton(btnSave.enabled or (id.idHasLUAShield <> buttonChecked(btnHasLUAshield))); // has the value changed?
id.idHasLUAShield := buttonChecked(btnHasLUAshield);
case id.idHasLUAShield of TRUE: begin
id.idPrevImageIx := id.idImageIx; // take a copy in case the user changes their mind
id.idImageIx := getStdIconIx(IL2_LUASHIELD); end;
FALSE: id.idImageIx := id.idPrevImageIx; end; // restore the previously-used image
vst.InvalidateNode(vst.getFirstSelected); // repaint the node's icon
updateMenuIcon; // repaint menuIcon
end;
procedure TConfigForm.btnMoveMenuItemDownClick(Sender: TObject);
var nextNode: PVirtualNode;
begin
// case vst.selectedCount = 0 of TRUE: EXIT; end;
case vst.getFirstSelected = NIL of TRUE: EXIT; end;
var node := vst.getFirstSelected;
var vOldParent := node.parent;
case node.childCount > 0 of TRUE: nextNode := vst.GetNextSibling(node);
FALSE: nextNode := vst.getNext(node, TRUE); end;
case nextNode = NIL of TRUE: begin
nextNode := vst.GetNextSibling(node.parent);
case nextNode = NIL of TRUE: EXIT; end; // end of the line
end;end;
case nextNode.childCount > 0 of TRUE: vst.moveTo(node, nextNode, amAddChildFirst, FALSE);
FALSE: vst.moveTo(node, nextNode, amInsertAfter, FALSE); end;
checkNodeParentage; // and populateBoxesFromItemData() and updateMenuIcon()
checkIfStillSubMenu(vOldParent);
enableSaveButton(TRUE);
end;
procedure TConfigForm.btnMoveMenuItemLeftClick(Sender: TObject);
var vNextNode: PVirtualNode;
begin
case vst.getFirstSelected = NIL of TRUE: EXIT; end;
var vNode := vst.getFirstSelected;
var vParent := vNode.parent;
case vParent = vst.RootNode of TRUE: EXIT; end;
vNextNode := vst.getNextSibling(vParent);
case vNextNode <> NIL of TRUE: begin
vst.moveTo(vNode, vNextNode, amInsertBefore, FALSE);
EXIT; end;end;
vNextNode := vParent.parent;
vst.moveTo(vNode, vNextNode, amAddChildFirst, FALSE);
checkNodeParentage; // and populateBoxesFromItemData() and updateMenuIcon()
checkIfStillSubMenu(vParent);
enableSaveButton(TRUE);
end;
procedure TConfigForm.btnMoveMenuItemUpClick(Sender: TObject);
begin
case vst.getFirstSelected = NIL of TRUE: EXIT; end;
var node := vst.getFirstSelected;
var vParent := node.parent;
var prevNode := vst.getPrevious(node, TRUE);
vst.moveTo(node, prevNode, amInsertBefore, FALSE);
checkNodeParentage; // and populateBoxesFromItemData() and updateMenuIcon()
checkIfStillSubMenu(vParent);
enableSaveButton(TRUE);
end;
procedure TConfigForm.btnRunAsAdminClick(Sender: TObject);
begin
reverseBtnChecked(sender);
case selData = NIL of TRUE: EXIT; end;
var id := selData;
enableSaveButton(btnSave.enabled or (id.idRunAsAdmin <> buttonChecked(btnRunAsAdmin))); // has the value changed?
id.idRunAsAdmin := buttonChecked(btnRunAsAdmin);