1 unit MenuShortcuts;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 uses
8   Classes, SysUtils, strutils, types, fgl,
9   // LCL
10   ActnList, ButtonPanel, Controls, Dialogs, StdCtrls, Menus, Forms, Graphics,
11   LCLType, LCLIntf, LCLProc,
12   // LazUtils
13   LazUTF8,
14   // IdeIntf
15   IDEDialogs, PropEdits,
16   // IDE
17   LazarusIDEStrConsts;
18 
19 type
20   TSCKind = (scUnknown,
21              scMenuItemSC, scMenuItemKey2, scMenuItemAccel,
22              scActionSC, scActionSecondary, scActionAccel,
23              scOtherCompAccel);
24   TDisplayType = (dtNone, dtBlack, dtBlackBold, dtGreyed, dtGreyedBold);
25   TDisplayClickEvent = procedure(isHeader: boolean; index: integer) of object;
26 
27 const
28   Margin = 6;
29   Double_Margin = Margin shl 1;
30   Leading = 4;
31   Double_Leading = Leading shl 1;
32   Treble_Leading = Leading + Double_Leading;
33   VDim = 20;
34   VTextOffset = 2;
35   Header_Color = TColor($00EDEFD6);
36 
37   Accelerator_Kinds = [scMenuItemAccel, scActionAccel, scOtherCompAccel];
38   MenuItem_Kinds = [scMenuItemSC, scMenuItemKey2, scMenuItemAccel];
39   ShortcutOnly_Kinds = [scMenuItemSC, scMenuItemKey2, scActionSC, scActionSecondary];
40   //#todo extend this list, or use one from elsewhere in LCL?
41   ShortCutKeys: array[0..48] of word = (VK_UNKNOWN,
42     VK_0, VK_1, VK_2, VK_3, VK_4, VK_5, VK_6, VK_7, VK_8, VK_9,
43     VK_A, VK_B, VK_C, VK_D, VK_E, VK_F, VK_G, VK_H, VK_I, VK_J, VK_K, VK_L,
44     VK_M, VK_N, VK_O, VK_P, VK_Q, VK_R, VK_S, VK_T, VK_U, VK_V, VK_W, VK_X,
45     VK_Y, VK_Z, VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8,
46     VK_F9, VK_F10, VK_F11, VK_F12);
47 
48 
49 type
50 
51   { TSCInfo }
52 
53   TSCInfo = class(TObject)
54   strict private
55     FComponent: TComponent;
56     FComponentName: string;
57     FKind: TSCKind;
58     FShortcut: TShortCut;
GetActionnull59     function GetAction: TAction;
GetCaptionnull60     function GetCaption: string;
GetMenuItemnull61     function GetMenuItem: TMenuItem;
GetToCompositeStringnull62     function GetToCompositeString: string;
63   public
64     constructor CreateWithParams(aComponent: TComponent; aKind: TSCKind; aSC: TShortCut);
65     property Action: TAction read GetAction;
66     property Caption: string read GetCaption;
67     property Component: TComponent read FComponent;
68     property ComponentName: string read FComponentName;
69     property Kind: TSCKind read FKind;
70     property MenuItem: TMenuItem read GetMenuItem;
71     property Shortcut: TShortCut read FShortcut;
72     property ToCompositeString: string read GetToCompositeString;
73   end;
74 
75   TSCInfoList = specialize TFPGList<TSCInfo>;
76 
77   { TSCList }
78 
79   TSCList = class(TObject)
80   strict private
81     FAcceleratorsInContainerCount: integer;
82     FScanList: TStringList;
83     FShortcutsInContainerCount: integer;
84     FInitialDuplicates: TSCInfoList;
85     FUniqueList: TSCInfoList;
GetScanListCompNamenull86     function GetScanListCompName(index: integer): string;
GetUniqueCountnull87     function GetUniqueCount: integer;
88   public
89     constructor Create;
90     destructor Destroy; override;
FindUniqueInfoForShortcutnull91     function FindUniqueInfoForShortcut(aSC: TShortCut): TSCInfo;
UniqueListContainsShortcutnull92     function UniqueListContainsShortcut(aSC: TShortCut): boolean;
93     procedure ClearAllLists;
94     procedure ScanContainerForShortcutsAndAccelerators;
95     procedure ScanContainerForShortcutsOnly;
96     procedure ScanSCListForDuplicates;
97     procedure SortByComponentPropertyName;
98     property AcceleratorsInContainerCount: integer read FAcceleratorsInContainerCount
99                                                   write FAcceleratorsInContainerCount;
100     property InitialDuplicates: TSCInfoList read FInitialDuplicates;
101     property ScanList: TStringList read FScanList;
102     property ScanListCompName[index: integer]: string read GetScanListCompName;
103     property ShortcutsInContainerCount: integer read FShortcutsInContainerCount
104                                                write FShortcutsInContainerCount;
105     property UniqueCount: integer read GetUniqueCount;
106   end;
107 
108   { TAddShortcutDialog }
109 
110   TAddShortcutDialog = class(TForm)
111   strict private
112     FButtonPanel: TButtonPanel;
113     FMenuItem: TMenuItem;
114     FNewShortcut: TShortCut;
115     FOldShortcut: TShortCut;
116     FShortCutGrabBox: TShortCutGrabBox;
117     procedure OKButtonClick(Sender: TObject);
118     procedure OnGrabBoxCloseUp(Sender: TObject);
119   public
120     constructor CreateWithMenuItem(AOwner: TComponent; aMI: TMenuItem; isMainSC: boolean; aSC: TShortCut);
121     property NewShortcut: TShortCut read FNewShortcut;
122     property OldShortcut: TShortCut write FOldShortcut;
123   end;
124 
125   TMenuShortcuts = class;
126 
127   { TEditShortcutCaptionDialog }
128 
129   TEditShortcutCaptionDialog = class(TForm)
130   strict private
131     FEditingCaption: boolean;
132     FInfo: TSCInfo;
133     FNewCaption: string;
134     FNewShortcut: TShortCut;
135     FOldCaption: string;
136     // GUI controls
137     FButtonPanel: TButtonPanel;
138     FEdit: TEdit;
139     FGrabBox: TCustomShortCutGrabBox;
140     FGroupBox: TGroupBox;
141     FShortcuts: TMenuShortcuts;
142     procedure CaptionEditChange(Sender: TObject);
143     procedure GrabBoxEnter(Sender: TObject);
144     procedure GrabBoxExit(Sender: TObject);
145     procedure OKButtonOnClick(Sender: TObject);
146   protected
147     procedure Activate; override;
148   public
149     constructor {%H-}CreateNew(aShortcuts: TMenuShortcuts; aSCInfo: TSCInfo);
150     property NewCaption: string read FNewCaption;
151     property NewShortcut: TShortCut read FNewShortcut;
152   end;
153 
154   TDualDisplay = class;
155 
156   TContents = class(TCustomControl)
157   private
158     FCol1MaxTextWidth: integer;
159     FCol2MaxTextWidth: integer;
160     FDualDisplay: TDualDisplay;
161     FOnContentsClick: TModalDialogFinished;
162     FSList: TStringList;
163   protected
164     procedure DoContentsClick(anIndex: integer);
165     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
166     procedure Paint; override;
167     property Col1MaxTextWidth: integer read FCol1MaxTextWidth;
168     property Col2MaxTextWidth: integer read FCol2MaxTextWidth;
169     property SList: TStringList read FSList;
170   public
171     constructor Create(AOwner: TComponent); override;
172     destructor Destroy; override;
173     procedure AddToList(const aLine: string; aDisplayType: TDisplayType=dtBlack);
174     procedure Clear;
175     property OnContentsClick: TModalDialogFinished read FOnContentsClick write FOnContentsClick;
176   end;
177 
178   { THeader }
179 
180   THeader = class(TCustomControl)
181   private
182     FCol1Header: string;
183     FCol2Header: string;
184     FColumn1TextWidth: integer;
185     FDisplayType: TDisplayType;
186     FDualDisplay: TDualDisplay;
187     FOnHeaderClick: TModalDialogFinished;
188   protected
189     procedure DoHeaderClick(anIndex: integer);
190     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
191     procedure Paint; override;
192   public
193     constructor Create(AOwner: TComponent); override;
194     procedure AddHeader(const aHeader: string; aDisplayType: TDisplayType);
195     procedure Clear;
196     property Column1TextWidth: integer read FColumn1TextWidth;
197     property OnHeaderClick: TModalDialogFinished read FOnHeaderClick write FOnHeaderClick;
198   end;
199 
200   { TDualDisplay }
201 
202   TDualDisplay = class(TCustomControl)
203   private
204     FCol1Right: integer;
205     FContents: TContents;
206     FHeader: THeader;
207     FOnDisplayClick: TDisplayClickEvent;
208     FSBox: TScrollBox;
209     FUpdating: boolean;
GetContentsCountnull210     function GetContentsCount: integer;
211     procedure HeaderContentsClick(Sender: TObject; index: integer);
212     procedure SetCol1Right(AValue: integer);
213   protected
GetControlClassDefaultSizenull214     class function GetControlClassDefaultSize: TSize; override;
TextWidthnull215     function TextWidth(const aText: string): integer;
216     property Updating: boolean read FUpdating;
217   public
218     constructor Create(AOwner: TComponent); override;
219     procedure AddHeader(const aHeader: string; aDT: TDisplayType=dtBlackBold);
220     procedure AddLine(const aLine: string; aDT: TDisplayType=dtBlack);
221     procedure BeginUpdate;
222     procedure Clear;
223     procedure ClearContents;
224     procedure ClearHeader;
225     procedure EndUpdate;
226     procedure InvalidateContents;
227     property Col1Right: integer read FCol1Right write SetCol1Right;
228     property ContentsCount: integer read GetContentsCount;
229     property OnDisplayClick: TDisplayClickEvent read FOnDisplayClick write FOnDisplayClick;
230   end;
231 
232   { TMenuShortcuts }
233 
234   TMenuShortcuts = class
235   private
236     FShortcutList: TSCList;
237     FShortcutMenuItemsCount: integer;
238     FShortcutConflictsCount: integer;
239   public
240     constructor Create;
241     destructor Destroy; override;
242     procedure Initialize;
243     procedure UpdateShortcutList(includeAccelerators: boolean=False);
244     procedure ResetMenuItemsCount;
Statisticsnull245     function Statistics(aShortcutCount: integer): string;
246   public
247     property ShortcutList: TSCList read FShortcutList;
248     property ShortcutMenuItemsCount: integer read FShortcutMenuItemsCount;
249     //property ShortcutConflictsCount: integer read FShortcutConflictsCount;
250   end;
251 
AmpersandStrippednull252 function AmpersandStripped(const aText: string): string;
AddNewOrEditShortcutDlgnull253 function AddNewOrEditShortcutDlg(aMI: TMenuItem; isMainSCut: boolean;
254                                  var aShortcut: TShortCut): boolean;
HasAcceleratornull255 function HasAccelerator(const aText: string; out aShortcut: TShortCut): boolean;
NewShortcutOrCaptionIsValidDlgnull256 function NewShortcutOrCaptionIsValidDlg(aConflictingInfo: TSCInfo;
257                                         out aNewShortcut: TShortCut;
258                                         out aNewCaption: string): boolean;
KindToPropertyNamenull259 function KindToPropertyName(aKind: TSCKind): string;
SplitCommaTextnull260 function SplitCommaText(const aCommaText: string; out firstBit: string): string;
SortByComponentPropertyNamenull261 function SortByComponentPropertyName(List: TStringList; Index1, Index2: Integer): Integer;
262 
263 
264 implementation
265 
AmpersandStrippednull266 function AmpersandStripped(const aText: string): string;
267 var
268   p: integer;
269 begin
270   Result:=aText;
271   p:=Pos('&', Result);
272   while (p > 0) do begin
273     Delete(Result, p, 1);
274     p:=Pos('&', Result);
275   end;
276 end;
277 
AddNewOrEditShortcutDlgnull278 function AddNewOrEditShortcutDlg(aMI: TMenuItem; isMainSCut: boolean;
279   var aShortcut: TShortCut): boolean;
280 var
281   dlg: TAddShortcutDialog;
282 begin
283   dlg:=TAddShortcutDialog.CreateWithMenuItem(nil, aMI, isMainSCut, aShortcut);
284   try
285     if (dlg.ShowModal = mrOK) then
286     begin
287       aShortcut:=dlg.NewShortcut;
288       Result:=True;
289     end
290     else
291       Result:=False;
292   finally
293     dlg.Free;
294   end;
295 end;
296 
HasAcceleratornull297 function HasAccelerator(const aText: string; out aShortcut: TShortCut): boolean;
298 var
299   p, UTF8Len: integer;
300   accelStr: string;
301 begin
302   Result := False;
303   aShortcut := 0;
304   if aText = '' then Exit;
305   p := 0;
306   repeat
307     p := PosEx('&', aText, p+1);
308     if (p = 0) or (p = Length(aText)) then Break;
309     if aText[p+1] <> '&' then  // '&&' is reduced to '&' by widgetset GUI.
310     begin
311       UTF8Len := UTF8CodepointSize(@aText[p+1]);
312       accelStr := UTF8UpperCase(Copy(aText, p+1, UTF8Len)); // force uppercase
313       // ToDo: Use the whole UTF-8 character in accelStr. How?
314       aShortcut := KeyToShortCut(Ord(accelStr[1]),
315       {$if defined(darwin) or defined(macos) or defined(iphonesim)} [ssMeta]
316       {$else} [ssAlt] {$endif});
317       Result := True;
318       Break;
319     end;
320   until False;
321 end;
322 {
323 function GetAcceleratedItemsCount(aMenu: TMenu): integer;
324 var
325   i: integer;
326 
327   procedure RecursiveCountAcceleratedCaptions(aMI: TMenuItem);
328   var
329     j: integer;
330     sc: TShortCut;
331   begin
332     if HasAccelerator(aMI.Caption, sc) then
333       Inc(Result);
334     for j:=0 to aMI.Count-1 do
335       RecursiveCountAcceleratedCaptions(aMI.Items[j]);
336   end;
337 
338 begin
339   Result:=0;
340   for i:=0 to aMenu.Items.Count-1 do
341     RecursiveCountAcceleratedCaptions(aMenu.Items[i]);
342 end;
343 }
344 procedure DoShortcutAccelScanCount(const aSCList: TSCList; shortcutsOnly: boolean);
345 var
346   dm: TDataModule;
347   frm: TCustomForm;
348   i, a: integer;
349   aLst: TActionList;
350   ac: TAction;
351   sc: TShortCut;
352   container: TComponent;
353 
354   procedure AddInfoToScanList(aComp: TComponent; aSC: TShortCut; aKind: TSCKind);
355   var
356     isAccel: boolean;
357   begin
358     isAccel:=(aKind in Accelerator_Kinds);
359     if isAccel and not shortcutsOnly then
360       aSCList.AcceleratorsInContainerCount:=aSCList.AcceleratorsInContainerCount+1
361     else
362       aSCList.ShortcutsInContainerCount:=aSCList.ShortcutsInContainerCount+1;
363     aSCList.ScanList.AddObject(ShortCutToText(aSC), TSCInfo.CreateWithParams(aComp, aKind, aSC));
364   end;
365 
366   procedure ScanMenu(aMenu: TMenu);
367   var
368     i: integer;
369 
370     procedure RecursiveScanItem(anItem:TMenuItem);
371     var
372       j: integer;
373       sc: TShortCut;
374     begin
375       if (anItem.ShortCut <> 0) then
376         AddInfoToScanList(anItem, anItem.ShortCut, scMenuItemSC);
377       if (anItem.ShortCutKey2 <> 0) then
378         AddInfoToScanList(anItem, anItem.ShortCutKey2, scMenuItemKey2);
379       if not shortcutsOnly and HasAccelerator(anItem.Caption, sc) then
380         AddInfoToScanList(anItem, sc, scMenuItemAccel);
381       for j:=0 to anItem.Count-1 do
382         RecursiveScanItem(anItem.Items[j]);
383     end;
384 
385   begin
386     for i:=0 to aMenu.Items.Count-1 do
387       RecursiveScanItem(aMenu.Items[i]);
388   end;
389 
390 begin
391   container:=GlobalDesignHook.LookupRoot as TComponent;
392   aSCList.ClearAllLists;
393   aSCList.AcceleratorsInContainerCount:=0;
394   aSCList.ShortcutsInContainerCount:=0;
395   if (container is TDataModule) then
396   begin
397     dm:=TDataModule(container);
398     for i:=0 to dm.ComponentCount-1 do
399       if (dm.Components[i] is TMenu) then
400         ScanMenu(TMenu(dm.Components[i]));
401   end
402   else if (container is TCustomForm) then
403   begin
404     frm:=TCustomForm(container);
405     for i:=0 to frm.ComponentCount-1 do
406       if (frm.Components[i] is TMenu) then
407         ScanMenu(TMenu(frm.Components[i]))
408       else if (frm.Components[i] is TActionList) then begin
409         aLst:=TActionList(frm.Components[i]);
410         for a:=0 to aLst.ActionCount-1 do begin
411           ac:=TAction(aLst.Actions[a]);
412           if (ac.ShortCut > 0) then
413             AddInfoToScanList(ac, ac.ShortCut, scActionSC);
414           if (ac.SecondaryShortCuts.Count > 0) then
415             AddInfoToScanList(ac, ac.SecondaryShortCuts.ShortCuts[0], scActionSecondary);
416           if not shortcutsOnly and HasAccelerator(ac.Caption, sc) then
417             AddInfoToScanList(ac, sc, scActionAccel);
418         end;
419       end
420       else begin
421         if not shortcutsOnly and (frm.Components[i] is TControl)
422         and HasAccelerator(TControl(frm.Components[i]).Caption, sc) then
423           AddInfoToScanList(frm.Components[i], sc, scOtherCompAccel);
424       end;
425   end;
426   Assert(aSCList.AcceleratorsInContainerCount+aSCList.ShortcutsInContainerCount=
427          aSCList.ScanList.Count,'DoShortcutAccelScanCount: internal counting error');
428 end;
429 
NewShortcutOrCaptionIsValidDlgnull430 function NewShortcutOrCaptionIsValidDlg(aConflictingInfo: TSCInfo; out
431   aNewShortcut: TShortCut; out aNewCaption: string): boolean;
432 var
433   dlg: TEditShortcutCaptionDialog;
434   ok: boolean;
435   sc: TShortCut;
436 begin
437   dlg:=TEditShortcutCaptionDialog.CreateNew(nil, aConflictingInfo);
438   try
439     Result:=(dlg.ShowModal = mrOK);
440     case (aConflictingInfo.Kind in Accelerator_Kinds) of
441       True: begin
442         if HasAccelerator(dlg.NewCaption, sc) then
443           ok:=(sc <> aConflictingInfo.Shortcut)
444         else
445           ok:=True;
446       end;
447       False: ok:=(aConflictingInfo.Shortcut <> dlg.NewShortcut);
448     end;
449     Result:=Result and ok;
450     if Result then
451       begin
452         aNewShortcut:=dlg.NewShortcut;
453         aNewCaption:=dlg.NewCaption;
454       end
455     else
456       begin
457         aNewShortcut:=0;
458         aNewCaption:='';
459       end;
460   finally
461     FreeAndNil(dlg);
462   end;
463 end;
464 
KindToPropertyNamenull465 function KindToPropertyName(aKind: TSCKind): string;
466 begin
467   Result:='';
468   case aKind of
469     scUnknown:   Result:='<unknown property>';
470     scActionAccel, scMenuItemAccel, scOtherCompAccel:
471                   Result:='Caption';
472     scActionSC, scMenuItemSC: Result:='ShortCut';
473     scActionSecondary: Result:='SecondaryShortcuts';
474     scMenuItemKey2:    Result:='ShortCutKey2';
475   end;
476 end;
477 
SplitCommaTextnull478 function SplitCommaText(const aCommaText: string; out firstBit: string): string;
479 var
480   p: integer;
481 begin
482   if (aCommaText = '') then begin
483     firstBit:='';
484     Exit('');
485   end;
486   p:=Pos(',', aCommaText);
487   if (p = 0) then begin
488     firstBit:=aCommaText;
489     Exit('');
490   end;
491   firstBit:=Copy(aCommaText, 1, Pred(p));
492   Result:=Copy(aCommaText, Succ(p), Length(aCommaText)-p);
493 end;
494 
SortByShortcutnull495 function SortByShortcut(const Item1, Item2: TSCInfo): Integer;
496 begin
497   if (Item1.Shortcut > Item2.Shortcut) then
498     Result:= +1
499   else if (Item1.Shortcut < Item2.Shortcut) then
500     Result:= -1
501   else
502     Result:=0;
503 end;
504 
SortFPListByComponentPropertyNamenull505 function SortFPListByComponentPropertyName(const Item1, Item2: TSCInfo): Integer;
506 begin
507   if (Item1.ComponentName > Item2.ComponentName) then
508     Result:= +1
509   else if (Item1.ComponentName < Item2.ComponentName) then
510     Result:= -1
511   else
512     Result:=0;
513 end;
514 
SortByComponentPropertyNamenull515 function SortByComponentPropertyName(List: TStringList; Index1, Index2: Integer): Integer;
516 var
517   name1: string;
518   name2: string;
519 begin
520   name1:=TSCInfo(List.Objects[Index1]).ComponentName;
521   name2:=TSCInfo(List.Objects[Index2]).ComponentName;
522   if (name1 > name2) then
523     Result:= +1
524   else if (name2 > name1) then
525     Result:= -1
526   else
527     Result:=0;
528 end;
529 
SortOnComponentPropertyNamenull530 function SortOnComponentPropertyName(List: TStringList; Index1, Index2: Integer): Integer;
531 var
532   s1, s2: string;
533 begin
534   s1:=TSCInfo(List.Objects[Index1]).ToCompositeString;
535   s2:=TSCInfo(List.Objects[Index2]).ToCompositeString;
536   Result:=AnsiCompareText(s1, s2);
537 end;
538 
539 
540 { TSCInfo }
541 
542 constructor TSCInfo.CreateWithParams(aComponent: TComponent; aKind: TSCKind;
543   aSC: TShortCut);
544 begin
545   FComponent:=aComponent;
546   FComponentName:=aComponent.Name;
547   FKind:=aKind;
548   FShortcut:=aSC;
549 end;
550 
GetActionnull551 function TSCInfo.GetAction: TAction;
552 begin
553   if (FComponent is TAction) then
554     Result:=TAction(FComponent)
555   else
556     Result:=nil;
557 end;
558 
TSCInfo.GetCaptionnull559 function TSCInfo.GetCaption: string;
560 begin
561   if (FComponent is TControl) then
562     Result:=TControl(FComponent).Caption
563   else
564     Result:=lisMenuEditorComponentIsUnexpectedKind;
565 end;
566 
TSCInfo.GetMenuItemnull567 function TSCInfo.GetMenuItem: TMenuItem;
568 begin
569   if (FComponent is TMenuItem) then
570     Result:=TMenuItem(FComponent)
571   else
572     Result:=nil;
573 end;
574 
TSCInfo.GetToCompositeStringnull575 function TSCInfo.GetToCompositeString: string;
576 begin
577   Result:=FComponent.Name + ShortCutToText(FShortcut);
578 end;
579 
580 { TSCList }
581 
582 constructor TSCList.Create;
583 begin
584   FScanList:=TStringList.Create;
585   FUniqueList:=TSCInfoList.Create;
586   FInitialDuplicates:=TSCInfoList.Create;
587   ScanContainerForShortcutsAndAccelerators;
588 end;
589 
590 destructor TSCList.Destroy;
591 begin
592   ClearAllLists;
593   FreeAndNil(FUniqueList);
594   FreeAndNil(FInitialDuplicates);
595   FreeAndNil(FScanList);
596   inherited Destroy;
597 end;
598 
GetScanListCompNamenull599 function TSCList.GetScanListCompName(index: integer): string;
600 var
601   inf: TSCInfo;
602 begin
603   if (index > -1) and (index < FScanList.Count) then begin
604     inf:=TSCInfo(FScanList.Objects[index]);
605     if (inf.ComponentName <> '') then
606       Result:=inf.ComponentName
607     else
608       Result:=lisMenuEditorComponentIsUnnamed;
609   end
610   else
611     Result:=Format(lisMenuEditorTSCListGetScanListCompNameInvalidIndexDForFScanLis,
612                    [index]);
613 end;
614 
TSCList.GetUniqueCountnull615 function TSCList.GetUniqueCount: integer;
616 begin
617   Result:=FUniqueList.Count;
618 end;
619 
620 procedure TSCList.ClearAllLists;
621 var
622   i: integer;
623 begin
624   for i:=0 to FScanList.Count-1 do
625     TSCInfo(FScanList.Objects[i]).Free;
626   FScanList.Clear;
627   FUniqueList.Clear;
628   FInitialDuplicates.Clear;
629 end;
630 
TSCList.UniqueListContainsShortcutnull631 function TSCList.UniqueListContainsShortcut(aSC: TShortCut): boolean;
632 var
633   inf: TSCInfo;
634 begin
635   for inf in FUniqueList do
636     if (inf.Shortcut = aSC) then
637       Exit(True);
638   Result:=False;
639 end;
640 
FindUniqueInfoForShortcutnull641 function TSCList.FindUniqueInfoForShortcut(aSC: TShortCut): TSCInfo;
642 var
643   inf: TSCInfo;
644 begin
645   for inf in FUniqueList do
646     if (inf.Shortcut = aSC) then
647       Exit(inf);
648   Result:=nil;
649 end;
650 
651 procedure TSCList.ScanContainerForShortcutsAndAccelerators;
652 begin
653   DoShortcutAccelScanCount(Self, False);
654   ScanSCListForDuplicates;
655   if (FInitialDuplicates.Count > 0) then
656     FInitialDuplicates.Sort(@SortByShortcut);
657   if (FUniqueList.Count > 0) then
658     FUniqueList.Sort(@SortByShortcut);
659 end;
660 //menushortcuts.pas(667,44) Error: Incompatible type for arg no. 1:
onstnull661 // Got "<address of function(const TSCInfo;const TSCInfo):LongInt;Register>",
662 // expected "<procedure variable type of function(Pointer;Pointer):LongInt;Register>"
663 
664 //menushortcuts.pas(669,37) Error: Incompatible type for arg no. 1:
665 // Got "<address of function(Pointer;Pointer):LongInt;Register>",
666 // expected "TFPGList$1$crc13D57BB4.<procedure variable type of function(const TSCInfo;const TSCInfo):LongInt;Register>"
667 
668 procedure TSCList.ScanContainerForShortcutsOnly;
669 begin
670   DoShortcutAccelScanCount(Self, True);
671 end;
672 
673 procedure TSCList.ScanSCListForDuplicates;
674 var
675   i: integer;
676   inf2, inf1: TSCInfo;
677 begin
678   FreeAndNil(FUniqueList);
679   FreeAndNil(FInitialDuplicates);
680   FUniqueList:=TSCInfoList.Create;
681   FInitialDuplicates:=TSCInfoList.Create;
682   for i:=0 to FScanList.Count-1 do
683     if UniqueListContainsShortcut(TSCInfo(FScanList.Objects[i]).Shortcut) then
684       FInitialDuplicates.Add(FScanList.Objects[i] as TSCInfo)
685     else
686       FUniqueList.Add(FScanList.Objects[i] as TSCInfo);
687   if (FInitialDuplicates.Count > 0) then begin
688     FInitialDuplicates.Sort(@SortFPListByComponentPropertyName);
689     for i:=FInitialDuplicates.Count-1 downto 1 do begin
690       inf2:=FInitialDuplicates[i];
691       inf1:=FInitialDuplicates[i-1];
692       if (CompareText(inf2.ComponentName, inf1.ComponentName) = 0)
693       and (inf2.Shortcut = inf1.Shortcut) then
694         FInitialDuplicates.Delete(i);
695     end;
696   end;
697 end;
698 
699 procedure TSCList.SortByComponentPropertyName;
700 begin
701   FScanList.CustomSort(@SortOnComponentPropertyName);
702 end;
703 
704 { TAddShortcutDialog }
705 
706 constructor TAddShortcutDialog.CreateWithMenuItem(AOwner: TComponent;
707   aMI: TMenuItem; isMainSC: boolean; aSC: TShortCut);
708 var
709   editing: boolean;
710   key: word;
711   shift: TShiftState;
712   i: integer;
713 begin
714   inherited CreateNew(AOwner);
715   FMenuItem:=aMI;
716   FOldShortcut:=aSC;
717   editing:=(aSC <> 0);
718   Position:=poScreenCenter;
719   BorderStyle:=bsDialog;
720   case editing of
721     False: if isMainSC then
722              Caption:=Format(lisMenuEditorEnterANewShortCutForS, [FMenuItem.Name])
723            else
724              Caption:=Format(lisMenuEditorEnterANewShortCutKey2ForS, [FMenuItem.Name]);
725     True : if isMainSC then
726              Caption:=Format(lisMenuEditorChangeTheShortCutForS, [FMenuItem.Name])
727            else
728              Caption:=Format(lisMenuEditorChangeTheShortCutKey2ForS, [FMenuItem.Name]);
729   end;
730   FButtonPanel:=TButtonPanel.Create(Self);
731   FButtonPanel.ShowButtons:=[pbOK, pbCancel];
732   FButtonPanel.OKButton.Name:='OKButton';
733   FButtonPanel.OKButton.DefaultCaption:=True;
734   FButtonPanel.OKButton.OnClick:=@OKButtonClick;
735   FButtonPanel.CancelButton.Name:='CancelButton';
736   FButtonPanel.CancelButton.DefaultCaption:=True;
737   FButtonPanel.Parent:=Self;
738   FShortCutGrabBox:=TShortCutGrabBox.Create(Self);
739   FShortCutGrabBox.BorderSpacing.Around:=Margin;
740   FShortCutGrabBox.GrabButton.Caption:='&Grab key';
741   // this rather restricted list covers most of the common values needed
742   // #todo - extend list?
743   with FShortCutGrabBox.KeyComboBox.Items do
744   begin
745     Clear;
746     BeginUpdate;
747     Add(lisMenuEditorNone);
748     for i:=1 to High(ShortCutKeys) do
749       Add(ShortCutToText(ShortCutKeys[i]));
750     EndUpdate;
751   end;
752   {$if defined(darwin) or defined(macos) or defined(iphonesim)}
753     FShortCutGrabBox.AllowedShifts:=[ssShift, ssCtrl, ssMeta]
754   {$else} FShortCutGrabBox.AllowedShifts:=[ssShift, ssCtrl, ssAlt] {$endif};
755   FShortCutGrabBox.KeyComboBox.OnCloseUp:=@OnGrabBoxCloseUp;
756   FShortCutGrabBox.Align:=alClient;
757   FShortCutGrabBox.MainOkButton:=FButtonPanel.OKButton;
758   if editing then begin
759     ShortCutToKey(FOldShortcut, key, shift);
760     FShortCutGrabBox.ShiftState:=shift;
761     FShortCutGrabBox.Key:=key;
762   end;
763   FShortCutGrabBox.Parent:=Self;
764   AutoSize:=True;
765 end;
766 
767 procedure TAddShortcutDialog.OKButtonClick(Sender: TObject);
768 begin
769   if (FShortCutGrabBox.Key <> VK_UNKNOWN) then
770     FNewShortcut:=KeyToShortCut(FShortCutGrabBox.Key, FShortCutGrabBox.ShiftState)
771   else
772     FNewShortcut:=0;
773 end;
774 
775 procedure TAddShortcutDialog.OnGrabBoxCloseUp(Sender: TObject);
776 begin
777   if (FShortCutGrabBox.KeyComboBox.ItemIndex = 0) then
778     FShortCutGrabBox.ShiftState:=[];
779 end;
780 
781 { TEditShortcutCaptionDialog }
782 
783 constructor TEditShortcutCaptionDialog.CreateNew(aShortcuts: TMenuShortcuts;
784   aSCInfo: TSCInfo);
785 var
786   s: string;
787   sse: TShiftStateEnum;
788   i: integer;
789 begin
790   FShortcuts:=aShortcuts;
791   FInfo:=aSCInfo;
792   Assert(aSCInfo<>nil,'TEditShortcutCaptionDialog.CreateNew: aSCInfo is nil');
793   Assert(aSCInfo.Kind<>scUnknown,'TEditShortcutCaptionDialog.CreateNew: aSCInfo is unknown type');
794   Assert(FShortcuts.ShortcutList.UniqueCount>0,'TEditShortcutCaptionDialog.CreateNew: unique list is empty');
795   inherited CreateNew(Nil);
796   FEditingCaption:=(FInfo.Kind in Accelerator_Kinds);
797   Position:=poScreenCenter;
798   BorderStyle:=bsDialog;
799   Constraints.MinWidth:=300;
800 
801   FGroupBox:=TGroupBox.Create(Self);
802   if FEditingCaption then
803     begin
804       Caption:=Format(lisMenuEditorChangeConflictingAcceleratorS,
805                       [ShortCutToText(FInfo.Shortcut)]);
806       if (FInfo.Kind = scMenuItemAccel) then
807         FOldCaption:=FInfo.MenuItem.Caption;
808       FEdit:=TEdit.Create(Self);
809       with FEdit do
810       begin
811         Align:=alClient;
812         BorderSpacing.Around:=Margin;
813         AutoSize:=True;
814         Text:=FOldCaption;
815         OnChange:=@CaptionEditChange;
816         Parent:=FGroupBox;
817       end;
818       s:=lisMenuEditorCaption;
819     end
820   else
821     begin
822       Caption:=Format(lisMenuEditorChangeShortcutConflictS,
823                       [ShortCutToText(FInfo.Shortcut)]);
824       s:=KindToPropertyName(FInfo.Kind);
825       // don't set values to old shortcut since they need to be changed anyhow
826       FGrabBox:=TCustomShortCutGrabBox.Create(Self);
827       with FGrabBox do
828       begin
829         Align:=alClient;
830         BorderSpacing.Around:=Margin;
831         AutoSize:=True;
832         GrabButton.Caption:=lisMenuEditorGrabKey;
833        // this rather restricted list covers most of the common values needed
834         with KeyComboBox.Items do
835         begin
836           Clear;
837           BeginUpdate;
838           for i:=Low(ShortCutKeys) to High(ShortCutKeys) do
839             Add(ShortCutToText(ShortCutKeys[i]));
840           EndUpdate;
841         end;
842         GrabButton.OnEnter:=@GrabBoxEnter; // we can't alter any grabBox OnClick event
843         KeyComboBox.OnEnter:=@GrabBoxEnter;
844         for sse in ShiftButtons do
845           ShiftCheckBox[sse].OnEnter:=@GrabBoxEnter;
846         OnExit:=@GrabBoxExit;
847         FGrabBox.Caption:=Format(lisMenuEditorChangeShortcutCaptionForComponent,
848                                  [s, FInfo.Component.Name]);
849         Parent:=FGroupBox;
850       end;
851     end;
852   FGroupBox.Caption:=Format(lisMenuEditorEditingSForS,[s, FInfo.Component.Name]);
853   FGroupBox.Align:=alTop;
854   FGroupBox.BorderSpacing.Around:=Margin;
855   FGroupBox.AutoSize:=True;
856   FGroupBox.Parent:=Self;
857 
858   FButtonPanel:=TButtonPanel.Create(Self);
859   with FButtonPanel do
860   begin
861     ShowButtons:=[pbOK, pbCancel];
862     Top:=1;
863     Align:=alTop;
864     OKButton.OnClick:=@OKButtonOnClick;
865     OKButton.ModalResult:=mrNone;
866     OKButton.Enabled:=False;
867     ShowBevel:=False;
868     Parent:=Self;
869   end;
870   AutoSize:=True;
871 end;
872 
873 procedure TEditShortcutCaptionDialog.CaptionEditChange(Sender: TObject);
874 var
875   newSC: TShortCut;
876   hasAccel: boolean;
877   ed: TEdit absolute Sender;
878   inf: TSCInfo;
879 begin
880   if not (Sender is TEdit) then
881     Exit;
882   if HasAccelerator(ed.Text, newSC) then
883     begin
884       if FShortcuts.ShortcutList.UniqueListContainsShortcut(newSC) then
885         begin
886           inf:=FShortcuts.ShortcutList.FindUniqueInfoForShortcut(newSC);
887           IDEMessageDialogAb(lisMenuEditorFurtherShortcutConflict,
888                      Format(lisMenuEditorSIsAlreadyInUse,
889                      [ShortCutToText(newSC), inf.Component.Name]),
890                      mtWarning, [mbOK], False);
891           FEdit.Text:=AmpersandStripped(FOldCaption);
892           FEdit.SetFocus;
893         end
894       else
895         begin
896           FNewShortcut:=newSC;
897           FNewCaption:=ed.Text;
898         end;
899     end
900   else
901     begin
902       FNewShortcut:=0;
903       FNewCaption:=ed.Text;
904     end;
905   hasAccel:=HasAccelerator(FEdit.Text, newSC);
906   FButtonPanel.OKButton.Enabled:=not hasAccel or (hasAccel and (newSC <> FInfo.Shortcut));
907 end;
908 
909 procedure TEditShortcutCaptionDialog.GrabBoxEnter(Sender: TObject);
910 begin
911   if not FButtonPanel.OKButton.Enabled then
912     FButtonPanel.OKButton.Enabled:=True;
913 end;
914 
915 procedure TEditShortcutCaptionDialog.GrabBoxExit(Sender: TObject);
916 var
917   newSC: TShortCut;
918   inf: TSCInfo;
919 begin
920   newSC:=KeyToShortCut(FGrabBox.Key, FGrabBox.ShiftState);
921   if (FInfo.Shortcut = newSC) then
922     begin
923       IDEMessageDialogAb(lisMenuEditorShortcutNotYetChanged,
924            Format(lisMenuEditorYouHaveToChangeTheShortcutFromSStoAvoidAConflict,
925                   [ShortCutToText(FInfo.Shortcut)]),
926                   mtWarning, [mbOK], False);
927       FGrabBox.KeyComboBox.SetFocus;
928       Exit;
929     end;
930   if FShortcuts.ShortcutList.UniqueListContainsShortcut(newSC) then
931     begin
932       inf:=FShortcuts.ShortcutList.FindUniqueInfoForShortcut(newSC);
933       IDEMessageDialogAb(lisMenuEditorFurtherShortcutConflict,
934            Format(lisMenuEditorSIsAlreadyInUse,
935                   [ShortCutToText(newSC), inf.Component.Name]),
936                   mtWarning, [mbOK], False);
937       FGrabBox.KeyComboBox.SetFocus;
938     end
939   else
940     begin
941       FNewShortcut:=newSC;
942       FButtonPanel.OKButton.Enabled:=True;
943     end;
944 end;
945 
946 procedure TEditShortcutCaptionDialog.OKButtonOnClick(Sender: TObject);
947 begin
948   if FEditingCaption then
949   begin
950     if (FEdit.Text = '') then
951     begin
952       IDEMessageDialogAb(lisMenuEditorCaptionShouldNotBeBlank,
953                  lisMenuEditorYouMustEnterTextForTheCaption,
954                  mtWarning, [mbOK], False);
955       FEdit.Text:=AmpersandStripped(FOldCaption);
956       FEdit.SetFocus;
957     end
958     else
959       ModalResult:=mrOK;
960   end
961   else
962     ModalResult:=mrOK;
963 end;
964 
965 procedure TEditShortcutCaptionDialog.Activate;
966 begin
967   inherited Activate;
968   FButtonPanel.OKButton.Enabled:=False;
969 end;
970 
971 { TContents }
972 
973 constructor TContents.Create(AOwner: TComponent);
974 begin
975   inherited Create(AOwner);
976   FDualDisplay:=AOwner as TDualDisplay;
977   FSList:=TStringList.Create;
978   Color:=clBtnFace;
979 end;
980 
981 destructor TContents.Destroy;
982 begin
983   FreeAndNil(FSList);
984   inherited Destroy;
985 end;
986 
987 procedure TContents.Clear;
988 begin
989   FSList.Clear;
990   Height:=0;
991 end;
992 
993 procedure TContents.DoContentsClick(anIndex: integer);
994 begin
995   if Assigned(FOnContentsClick) and (anIndex < FSList.Count) then
996     FOnContentsClick(Self, anIndex);
997 end;
998 
999 procedure TContents.Paint;
1000 var
1001   s, s1, s2: string;
1002   i: integer = 0;
1003   col1, col2: integer;
1004   dt: TDisplayType;
1005 begin
1006   if FDualDisplay.Updating then
1007     Exit;
1008   Canvas.FillRect(ClientRect);
1009   col2:=FDualDisplay.Col1Right + Leading;
1010   for s in FSList do begin
1011     s2:=SplitCommaText(s, s1);
1012     col1:=FDualDisplay.Col1Right - Leading - Canvas.TextWidth(s1);
1013     dt:=TDisplayType(PtrUInt(FSList.Objects[i]));
1014     case dt of
1015       dtNone: begin s1:=''; s2:=''; end;
1016       dtBlack: begin
1017         if (Canvas.Font.Color <> clBlack) then Canvas.Font.Color:=clBlack;
1018         if (Canvas.Font.Style <> []) then Canvas.Font.Style:=[];
1019       end;
1020       dtBlackBold: begin
1021         if (Canvas.Font.Color <> clBlack) then Canvas.Font.Color:=clBlack;
1022         if (Canvas.Font.Style <> [fsBold]) then Canvas.Font.Style:=[fsBold];
1023       end;
1024       dtGreyed: begin
1025         if (Canvas.Font.Color <> clGrayText) then Canvas.Font.Color:=clGrayText;
1026         if (Canvas.Font.Style <> []) then Canvas.Font.Style:=[];
1027       end;
1028       dtGreyedBold: begin
1029         if (Canvas.Font.Color <> clGrayText) then Canvas.Font.Color:=clGrayText;
1030         if (Canvas.Font.Style <> [fsBold]) then Canvas.Font.Style:=[fsBold];
1031       end;
1032     end;
1033     Canvas.TextOut(col1, i*VDim + VTextOffset, s1);
1034     Canvas.TextOut(col2, i*VDim + VTextOffset, s2);
1035     Inc(i);
1036   end;
1037 end;
1038 
1039 procedure TContents.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1040 begin
1041   inherited MouseDown(Button, Shift, X, Y);
1042   DoContentsClick(Y div VDim);
1043 end;
1044 
1045 procedure TContents.AddToList(const aLine: string; aDisplayType: TDisplayType);
1046 var
1047   h, w, cw, ch: integer;
1048   second, first: string;
1049 begin
1050   Assert(Parent<>nil,'TContents.AddToList: Parent is nil');
1051   Assert(aDisplayType<>dtNone,'TContents.AddToList: TDisplayType=dtNone');
1052   FSList.AddObject(aLine, TObject(PtrUInt(aDisplayType)));
1053   second:=SplitCommaText(aLine, first);
1054   w:=FDualDisplay.TextWidth(second);
1055   if (w > FCol2MaxTextWidth) then
1056     FCol2MaxTextWidth:=w;
1057   w:=FDualDisplay.TextWidth(first);
1058   if (w > FCol1MaxTextWidth) then
1059     FCol1MaxTextWidth:=w;
1060   w:=FCol1MaxTextWidth + FCol2MaxTextWidth + Treble_Leading;
1061   if (w < Parent.Width) then
1062     w:=Parent.Width;
1063   h:=FSList.Count*VDim;
1064   ch:=ClientHeight;
1065   cw:=ClientWidth;
1066   if (h > ch) or (w > cw) then
1067     SetBounds(0, 0, w, h);
1068 end;
1069 
1070 { THeader }
1071 
1072 procedure THeader.DoHeaderClick(anIndex: integer);
1073 begin
1074   if Assigned(FOnHeaderClick) then
1075     FOnHeaderClick(Self, anIndex);
1076 end;
1077 
1078 procedure THeader.Paint;
1079 begin
1080   Canvas.Brush.Color:=Header_Color;
1081   Canvas.FillRect(ClientRect);
1082   case FDisplayType of
1083     dtNone: begin FCol1Header:=''; FCol2Header:=''; end;
1084     dtBlack: begin
1085       if (Canvas.Font.Color <> clBlack) then Canvas.Font.Color:=clBlack;
1086       if (Canvas.Font.Style <> []) then Canvas.Font.Style:=[];
1087     end;
1088     dtBlackBold: begin
1089       if (Canvas.Font.Color <> clBlack) then Canvas.Font.Color:=clBlack;
1090       if (Canvas.Font.Style <> [fsBold]) then Canvas.Font.Style:=[fsBold];
1091     end;
1092     dtGreyed: begin
1093       if (Canvas.Font.Color <> clGrayText) then Canvas.Font.Color:=clGrayText;
1094       if (Canvas.Font.Style <> []) then Canvas.Font.Style:=[];
1095     end;
1096     dtGreyedBold: begin
1097       if (Canvas.Font.Color <> clGrayText) then Canvas.Font.Color:=clGrayText;
1098       if (Canvas.Font.Style <> [fsBold]) then Canvas.Font.Style:=[fsBold];
1099     end;
1100   end;
1101   Canvas.TextOut(FDualDisplay.Col1Right - Leading - FColumn1TextWidth, VTextOffset, FCol1Header);
1102   Canvas.TextOut(FDualDisplay.Col1Right + Leading, VTextOffset, FCol2Header);
1103 end;
1104 
1105 procedure THeader.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1106 var
1107   i: integer=0;
1108 begin
1109   inherited MouseDown(Button, Shift, X, Y);
1110   if (X > FDualDisplay.Col1Right) then
1111     i:=1;
1112   DoHeaderClick(i);
1113 end;
1114 
1115 constructor THeader.Create(AOwner: TComponent);
1116 begin
1117   inherited Create(AOwner);
1118   FDualDisplay:=AOwner as TDualDisplay;
1119   Align:=alTop;
1120   Height:=VDim;
1121   Canvas.Font.Style:=[fsBold];
1122 end;
1123 
1124 procedure THeader.AddHeader(const aHeader: string; aDisplayType: TDisplayType);
1125 begin
1126   FCol2Header:=SplitCommaText(aHeader, FCol1Header);
1127   FDisplayType:=aDisplayType;
1128   FColumn1TextWidth:=FDualDisplay.TextWidth(FCol1Header);
1129   Repaint;
1130 end;
1131 
1132 procedure THeader.Clear;
1133 begin
1134   FColumn1TextWidth:=0;
1135   FDisplayType:=dtNone;
1136   Invalidate;
1137 end;
1138 
1139 { TDualDisplay }
1140 
1141 constructor TDualDisplay.Create(AOwner: TComponent);
1142 begin
1143   inherited Create(AOwner);
1144   Name:='DualDisplay';
1145   Color:=clBtnFace;
1146   Canvas.Font.Style:=[fsBold];
1147   with GetControlClassDefaultSize do
1148     SetInitialBounds(0, 0, cx, cy);
1149 
1150   FHeader:=THeader.Create(Self);
1151   with FHeader do begin
1152     Name:='Header';
1153     OnHeaderClick:=@HeaderContentsClick;
1154     Parent:=Self;
1155   end;
1156 
1157   FSBox:=TScrollBox.Create(Self);
1158   with FSBox do begin
1159     Align:=alClient;
1160     BorderStyle:=bsNone;
1161     AutoScroll:=True;
1162     Parent:=Self;
1163   end;
1164 
1165   FContents:=TContents.Create(Self);
1166   with FContents do begin
1167     Name:='Contents';
1168     SetInitialBounds(0, 0, FSBox.Width, FSBox.Height);
1169     OnContentsClick:=@HeaderContentsClick;
1170     Color:=clBtnFace;
1171     Parent:=FSBox;
1172   end;
1173 end;
1174 
TDualDisplay.GetContentsCountnull1175 function TDualDisplay.GetContentsCount: integer;
1176 begin
1177   Result:=FContents.SList.Count;
1178 end;
1179 
1180 procedure TDualDisplay.HeaderContentsClick(Sender: TObject; index: integer);
1181 begin
1182   if Assigned(FOnDisplayClick) then begin
1183     Assert(Sender<>nil,'TDualDisplay.HeaderContentsClick: Sender is nil');
1184     Assert(index>-1,'TDualDisplay.HeaderContentsClick: index is negative');
1185     if (Sender is TContents) then begin
1186       Assert(index<GetContentsCount,'TDualDisplay.HeaderContentsClick: index exceeds contents count');
1187       FOnDisplayClick(False, index);
1188     end
1189     else if (Sender is THeader) then begin
1190       Assert(index<2,'TDualDisplay.HeaderContentsClick: index value too high');
1191       FOnDisplayClick(True, index);
1192     end
1193     else Assert(True,'TDualDisplay.HeaderContentsClick: Sender is invalid type');
1194   end;
1195 end;
1196 
1197 procedure TDualDisplay.SetCol1Right(AValue: integer);
1198 begin
1199   if (FCol1Right <> AValue) then begin
1200     FCol1Right:=AValue;
1201     FHeader.Invalidate;
1202     FContents.Invalidate;
1203   end;
1204 end;
1205 
TDualDisplay.GetControlClassDefaultSizenull1206 class function TDualDisplay.GetControlClassDefaultSize: TSize;
1207 begin
1208   Result.cx:=200;
1209   Result.cy:=120;
1210 end;
1211 
TDualDisplay.TextWidthnull1212 function TDualDisplay.TextWidth(const aText: string): integer;
1213 begin
1214   Result:=Canvas.TextWidth(aText);
1215 end;
1216 
1217 procedure TDualDisplay.AddHeader(const aHeader: string; aDT: TDisplayType);
1218 var
1219   tmp: integer;
1220 begin
1221   FHeader.AddHeader(aHeader, aDT);
1222   tmp:=FCol1Right - Double_Leading;
1223   if (FHeader.Column1TextWidth > tmp) then
1224     SetCol1Right(FHeader.Column1TextWidth + Double_Leading);
1225   tmp:=TextWidth(aHeader) + Treble_Leading;
1226   if (tmp > Width) then begin
1227     Width:=tmp;
1228     FHeader.Width:=tmp;
1229     FContents.Width:=tmp;
1230   end;
1231   FHeader.Repaint;
1232 end;
1233 
1234 procedure TDualDisplay.AddLine(const aLine: string; aDT: TDisplayType);
1235 var
1236   tmp: integer;
1237 begin
1238   FContents.AddToList(aLine, aDT);
1239   tmp:=FCol1Right - Double_Leading;
1240   if (FContents.Col1MaxTextWidth > tmp) then
1241     SetCol1Right(FContents.Col1MaxTextWidth + Double_Leading);
1242   tmp:=FContents.Width;
1243   if (tmp > ClientWidth) then begin
1244     Width:=tmp;
1245     FHeader.Width:=tmp;
1246   end;
1247 end;
1248 
1249 procedure TDualDisplay.BeginUpdate;
1250 begin
1251   FUpdating:=True;
1252 end;
1253 
1254 procedure TDualDisplay.EndUpdate;
1255 begin
1256   FUpdating:=False;
1257 end;
1258 
1259 procedure TDualDisplay.ClearHeader;
1260 begin
1261   FHeader.Clear;
1262 end;
1263 
1264 procedure TDualDisplay.Clear;
1265 begin
1266   FHeader.Clear;
1267   FContents.Clear;
1268 end;
1269 
1270 procedure TDualDisplay.ClearContents;
1271 begin
1272   FContents.Clear;
1273 end;
1274 
1275 procedure TDualDisplay.InvalidateContents;
1276 begin
1277   FContents.Invalidate;
1278 end;
1279 
1280 { TMenuShortcuts }
1281 
1282 constructor TMenuShortcuts.Create;
1283 begin
1284   FShortcutList:=TSCList.Create;
1285 end;
1286 
1287 destructor TMenuShortcuts.Destroy;
1288 begin
1289   FShortcutList.Free;
1290   inherited Destroy;
1291 end;
1292 
1293 procedure TMenuShortcuts.Initialize;
1294 begin
1295   FShortcutList.ClearAllLists;
1296   FShortcutList.ScanContainerForShortcutsAndAccelerators;
1297   FShortcutConflictsCount:=FShortcutList.InitialDuplicates.Count;
1298 end;
1299 
1300 procedure TMenuShortcuts.UpdateShortcutList(includeAccelerators: boolean);
1301 begin
1302   if includeAccelerators then
1303     FShortcutList.ScanContainerForShortcutsAndAccelerators
1304   else
1305     FShortcutList.ScanContainerForShortcutsOnly;
1306 end;
1307 
1308 procedure TMenuShortcuts.ResetMenuItemsCount;
1309 begin
1310   FShortcutMenuItemsCount := -1;
1311 end;
1312 
Statisticsnull1313 function TMenuShortcuts.Statistics(aShortcutCount: integer): string;
1314 begin
1315   if (FShortcutMenuItemsCount <> aShortcutCount) then
1316   begin
1317     FShortcutMenuItemsCount := aShortcutCount;
1318     Result := Format(lisMenuEditorShortcutItemsS, [IntToStr(FShortcutMenuItemsCount)]);
1319   end
1320   else
1321     Result := '';
1322 end;
1323 
1324 end.
1325 
1326