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