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