1 unit MenuDesignerBase;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 // FCL
9 Classes, SysUtils, fgl,
10 // LCL
11 Controls, Forms, Menus, Graphics,
12 // LazUtils
13 LazLoggerBase,
14 // IdeIntf
15 FormEditingIntf, ComponentEditors,
16 // IDE
17 MenuShortcuts, MenuTemplates;
18
19 type
20
21 TShadowItemDisplayState = (dsNormal, dsSelected, dsDisabled);
22 TByteArray = Array of Byte;
23
24 { TShadowItemBase }
25
26 TShadowItemBase = class(TCustomControl)
27 private
28 protected
29 FRealItem: TMenuItem;
30 FState: TShadowItemDisplayState;
31 public
32 constructor Create(AOwner: TComponent; aRealItem: TMenuItem); reintroduce;
33 destructor Destroy; override;
GetHeightnull34 function GetHeight: integer;
GetWidthnull35 function GetWidth: integer; virtual; abstract;
36 procedure ShowDisabled;
37 procedure ShowNormal;
38 procedure ShowSelected;
39 public
40 property RealItem: TMenuItem read FRealItem write FRealItem;
41 end;
42
43 TShadowItemList = specialize TFPGList<TShadowItemBase>;
44
45 { TShadowBoxBase }
46
47 TShadowBoxBase = class(TCustomControl)
48 private
GetRadioGroupValuesnull49 function GetRadioGroupValues: TByteArray;
50 protected
51 FLevel: integer;
52 FLastRIValue: boolean;
53 FParentBox: TShadowBoxBase;
54 FParentMenuItem: TMenuItem;
55 FShadowList: TShadowItemList;
GetIsMainMenunull56 function GetIsMainMenu: boolean; virtual; abstract;
GetIsMenuBarnull57 function GetIsMenuBar: boolean; virtual; abstract;
58 public
59 constructor Create(AOwner: TComponent; aParentItem: TMenuItem); reintroduce;
60 destructor Destroy; override;
61 public
GetInnerDimsnull62 function GetInnerDims: TPoint;
63 property IsMainMenu: boolean read GetIsMainMenu;
64 property IsMenuBar: boolean read GetIsMenuBar;
65 property Level: integer read FLevel;
66 property LastRIValue: boolean read FLastRIValue write FLastRIValue;
67 property ParentMenuItem: TMenuItem read FParentMenuItem;
68 property ParentBox: TShadowBoxBase read FParentBox;
69 property ShadowList: TShadowItemList read FShadowList;
70 property RadioGroupValues: TByteArray read GetRadioGroupValues;
71 end;
72
73 TShadowBoxList = specialize TFPGList<TShadowBoxBase>;
74
75 { TShadowMenuBase }
76
77 TShadowMenuBase = class(TScrollBox)
78 private
79 protected
80 FEditorDesigner: TComponentEditorDesigner;
81 FLookupRoot: TComponent;
82 FMainCanvas: TCanvas;
83 FMenu: TMenu;
84 FSelectedMenuItem: TMenuItem;
85 FBoxList: TShadowBoxList;
GetStringWidthnull86 function GetStringWidth(const aText: string; isBold: boolean): integer;
87 public
88 constructor Create(AOwner: TComponent; aMenu: TMenu); reintroduce;
89 destructor Destroy; override;
90 procedure RefreshFakes; virtual; abstract;
91 procedure SetSelectedMenuItem(aMI: TMenuItem;
92 viaDesigner, prevWasDeleted: boolean); virtual; abstract;
93 procedure UpdateBoxLocationsAndSizes; virtual; abstract;
GetParentBoxForMenuItemnull94 function GetParentBoxForMenuItem(aMI: TMenuItem): TShadowBoxBase;
GetShadowForMenuItemnull95 function GetShadowForMenuItem(aMI: TMenuItem): TShadowItemBase;
IsMainMenunull96 function IsMainMenu: boolean;
97 public
98 property EditorDesigner: TComponentEditorDesigner read FEditorDesigner;
99 property LookupRoot: TComponent read FLookupRoot;
100 property SelectedMenuItem: TMenuItem read FSelectedMenuItem write FSelectedMenuItem;
101 property BoxList: TShadowBoxList read FBoxList;
102 end;
103
104 { TMenuDesignerBase }
105
106 TMenuDesignerBase = class
107 private
108 protected
109 FShadowMenu: TShadowMenuBase;
110 FShortcuts: TMenuShortcuts;
111 FTemplatesSaved: boolean;
112 FSavedTemplatesCount: integer;
113 FTotalMenuItemsCount: integer;
114 FVariableGlyphsInMenuBar: boolean;
115 public
116 constructor Create;
117 destructor Destroy; override;
118 procedure CreateShadowMenu(aMenu: TMenu; aSelect: TMenuItem;
119 aWidth, aHeight: integer); virtual; abstract;
120 procedure FreeShadowMenu;
121 procedure UpdateTemplatesCount;
122 public
123 property ShadowMenu: TShadowMenuBase read FShadowMenu write FShadowMenu;
124 property Shortcuts: TMenuShortcuts read FShortcuts;
125 property TemplatesSaved: boolean read FTemplatesSaved;
126 property TotalMenuItemsCount: integer read FTotalMenuItemsCount
127 write FTotalMenuItemsCount;
128 property VariableGlyphsInMenuBar: boolean read FVariableGlyphsInMenuBar
129 write FVariableGlyphsInMenuBar;
130 property SavedTemplatesCount: integer read FSavedTemplatesCount;
131 end;
132
133
134 implementation
135
136 { TShadowItemBase }
137
138 constructor TShadowItemBase.Create(AOwner: TComponent; aRealItem: TMenuItem);
139 begin
140 inherited Create(AOwner);
141 FRealItem:=aRealItem;
142 end;
143
144 destructor TShadowItemBase.Destroy;
145 begin
146 inherited Destroy;
147 end;
148
TShadowItemBase.GetHeightnull149 function TShadowItemBase.GetHeight: integer;
150 begin
151 if FRealItem.IsInMenuBar then
152 Result:=MenuBar_Height
153 else if FRealItem.IsLine then
154 Result:=Separator_Height
155 else
156 Result:=DropDown_Height;
157 end;
158
159 procedure TShadowItemBase.ShowDisabled;
160 begin
161 if (FState <> dsDisabled) then begin
162 FState:=dsDisabled;
163 Invalidate;
164 end;
165 end;
166
167 procedure TShadowItemBase.ShowNormal;
168 begin
169 if (FState <> dsNormal) then begin
170 FState:=dsNormal;
171 Invalidate;
172 end;
173 end;
174
175 procedure TShadowItemBase.ShowSelected;
176 begin
177 if (FState <> dsSelected) then begin
178 FState:=dsSelected;
179 Invalidate;
180 end;
181 end;
182
183 { TShadowBoxBase }
184
185 constructor TShadowBoxBase.Create(AOwner: TComponent; aParentItem: TMenuItem);
186 begin
187 inherited Create(AOwner);
188 Assert(aParentItem<>nil,'TShadowBox.CreateWithParentBox: aParentItem parameter is nil');
189 FParentMenuItem:=aParentItem;
190 FShadowList:=TShadowItemList.Create;
191 end;
192
193 destructor TShadowBoxBase.Destroy;
194 begin
195 FreeAndNil(FShadowList);
196 inherited Destroy;
197 end;
198
TShadowBoxBase.GetRadioGroupValuesnull199 function TShadowBoxBase.GetRadioGroupValues: TByteArray;
200 var
201 rgSet: set of byte = [];
202 g: byte;
203 si: TShadowItemBase;
204 mi: TMenuItem;
205 begin
206 SetLength(Result{%H-}, 0);
207 for si in FShadowList do
208 begin
209 mi:=si.RealItem;
210 if mi.RadioItem then begin
211 g:=mi.GroupIndex;
212 if not (g in rgSet) then begin
213 Include(rgSet, g);
214 SetLength(Result, Length(Result)+1);
215 Result[Length(Result)-1] := g;
216 end;
217 end;
218 end;
219 end;
220
GetInnerDimsnull221 function TShadowBoxBase.GetInnerDims: TPoint;
222 var
223 si: TShadowItemBase;
224 w: integer;
225 begin
226 FillChar(Result{%H-}, SizeOf(Result), 0);
227 for si in FShadowList do begin
228 Inc(Result.y, si.GetHeight);
229 w:=si.GetWidth;
230 if (Result.x < w) then
231 Result.x:=w;
232 end;
233 end;
234
235 { TShadowMenuBase }
236
237 constructor TShadowMenuBase.Create(AOwner: TComponent; aMenu: TMenu);
238 begin
239 inherited Create(AOwner);
240 FMenu := aMenu;
241 FEditorDesigner := FindRootDesigner(FMenu) as TComponentEditorDesigner;
242 FLookupRoot := FEditorDesigner.LookupRoot;
243 FBoxList := TShadowBoxList.Create;
244 end;
245
246 destructor TShadowMenuBase.Destroy;
247 begin
248 FEditorDesigner:=nil;
249 FreeAndNil(FBoxList);
250 inherited Destroy;
251 end;
252
TShadowMenuBase.GetStringWidthnull253 function TShadowMenuBase.GetStringWidth(const aText: string; isBold: boolean): integer;
254 begin
255 if isBold then
256 FMainCanvas.Font.Style:=[fsBold]
257 else
258 FMainCanvas.Font.Style:=[];
259 Result:=FMainCanvas.TextWidth(aText);
260 end;
261
GetParentBoxForMenuItemnull262 function TShadowMenuBase.GetParentBoxForMenuItem(aMI: TMenuItem): TShadowBoxBase;
263 var
264 sb: TShadowBoxBase;
265 si: TShadowItemBase;
266 begin
267 for sb in FBoxList do
268 for si in sb.ShadowList do
269 if si.RealItem = aMI then
270 Exit(sb);
271 Result:=nil;
272 end;
273
GetShadowForMenuItemnull274 function TShadowMenuBase.GetShadowForMenuItem(aMI: TMenuItem): TShadowItemBase;
275 var
276 sb: TShadowBoxBase;
277 si: TShadowItemBase;
278 begin
279 for sb in FBoxList do
280 for si in sb.ShadowList do
281 if si.RealItem = aMI then
282 Exit(si);
283 Result:=nil;
284 end;
285
TShadowMenuBase.IsMainMenunull286 function TShadowMenuBase.IsMainMenu: boolean;
287 begin
288 Result := FMenu is TMainMenu;
289 end;
290
291 { TMenuDesignerBase }
292
293 constructor TMenuDesignerBase.Create;
294 begin
295 FShortcuts:=TMenuShortcuts.Create;
296 FShortcuts.Initialize;
297 FTemplatesSaved:=SavedTemplatesExist;
298 end;
299
300 destructor TMenuDesignerBase.Destroy;
301 begin
302 FreeShadowMenu;
303 FreeAndNil(FShortcuts);
304 inherited Destroy;
305 end;
306
307 procedure TMenuDesignerBase.FreeShadowMenu;
308 begin
309 if FShadowMenu=nil then exit;
310 FShadowMenu.Parent:=nil;
311 Application.ReleaseComponent(FShadowMenu);
312 FShadowMenu:=nil;
313 end;
314
315 procedure TMenuDesignerBase.UpdateTemplatesCount;
316 begin
317 FTemplatesSaved:=SavedTemplatesExist;
318 DebugLn('Hint: (lazarus) [TMenuDesignerBase.UpdateTemplatesCount] SavedTemplatesExist is %s',[booltostr(FTemplatesSaved)]);
319 FSavedTemplatesCount:=GetSavedTemplatesCount;
320 end;
321
322 end.
323
324