source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Design/TntMenus_Design.pas@ 1647

Last change on this file since 1647 was 453, checked in by Kevin Toppenberg, 17 years ago

Initial upload of TMG-CPRS 1.0.26.69
File size: 12.5 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntMenus_Design;
13
14{$INCLUDE ..\Source\TntCompilers.inc}
15
16{*******************************************************}
17{ Special Thanks to Francisco Leong for getting these }
18{ menu designer enhancements to work w/o MnuBuild. }
19{*******************************************************}
20
21interface
22
23{$IFDEF COMPILER_6} // Delphi 6 and BCB 6 have MnuBuild available
24 {$DEFINE MNUBUILD_AVAILABLE}
25{$ENDIF}
26
27{$IFDEF COMPILER_7} // Delphi 7 has MnuBuild available
28 {$DEFINE MNUBUILD_AVAILABLE}
29{$ENDIF}
30
31uses
32 Windows, Classes, Menus, Messages,
33 {$IFDEF MNUBUILD_AVAILABLE} MnuBuild, {$ENDIF}
34 DesignEditors, DesignIntf;
35
36type
37 TTntMenuEditor = class(TComponentEditor)
38 public
39 procedure ExecuteVerb(Index: Integer); override;
40 function GetVerb(Index: Integer): string{TNT-ALLOW string}; override;
41 function GetVerbCount: Integer; override;
42 end;
43
44procedure Register;
45
46implementation
47
48uses
49 {$IFDEF MNUBUILD_AVAILABLE} MnuConst, {$ELSE} DesignWindows, {$ENDIF} SysUtils, Graphics, ActnList,
50 Controls, Forms, TntDesignEditors_Design, TntActnList, TntMenus;
51
52procedure Register;
53begin
54 RegisterComponentEditor(TTntMainMenu, TTntMenuEditor);
55 RegisterComponentEditor(TTntPopupMenu, TTntMenuEditor);
56end;
57
58function GetMenuBuilder: TForm{TNT-ALLOW TForm};
59{$IFDEF MNUBUILD_AVAILABLE}
60begin
61 Result := MenuEditor;
62{$ELSE}
63var
64 Comp: TComponent;
65begin
66 Result := nil;
67 if Application <> nil then
68 begin
69 Comp := Application.FindComponent('MenuBuilder');
70 if Comp is TForm{TNT-ALLOW TForm} then
71 Result := TForm{TNT-ALLOW TForm}(Comp);
72 end;
73{$ENDIF}
74end;
75
76{$IFDEF DELPHI_9} // verified against Delphi 9
77type
78 THackMenuBuilder = class(TDesignWindow)
79 protected
80 Fields: array[1..26] of TObject;
81 FWorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
82 end;
83{$ENDIF}
84
85{$IFDEF COMPILER_10_UP}
86{$IFDEF DELPHI_10} // NOT verified against Delphi 10
87type
88 THackMenuBuilder = class(TDesignWindow)
89 protected
90 Fields: array[1..26] of TObject;
91 FWorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
92 end;
93{$ENDIF}
94{$ENDIF}
95
96function GetMenuBuilder_WorkMenu(MenuBuilder: TForm{TNT-ALLOW TForm}): TMenuItem{TNT-ALLOW TMenuItem};
97begin
98 if MenuBuilder = nil then
99 Result := nil
100 else begin
101 {$IFDEF MNUBUILD_AVAILABLE}
102 Result := MenuEditor.WorkMenu;
103 {$ELSE}
104 Result := THackMenuBuilder(MenuBuilder).FWorkMenu;
105 Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}),
106 'TNT Internal Error: THackMenuBuilder has incorrect internal layout.');
107 {$ENDIF}
108 end;
109end;
110
111{$IFDEF DELPHI_9} // verified against Delphi 9
112type
113 THackMenuItemWin = class(TCustomControl)
114 protected
115 FxxxxCaptionExtent: Integer;
116 FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
117 end;
118{$ENDIF}
119
120{$IFDEF DELPHI_10} // beta: NOT verified against Delphi 10
121type
122 THackMenuItemWin = class(TCustomControl)
123 protected
124 FxxxxCaptionExtent: Integer;
125 FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
126 end;
127{$ENDIF}
128
129function GetMenuItem(Control: TWinControl; DoVerify: Boolean = True): TMenuItem{TNT-ALLOW TMenuItem};
130begin
131 {$IFDEF MNUBUILD_AVAILABLE}
132 if Control is TMenuItemWin then
133 Result := TMenuItemWin(Control).MenuItem
134 {$ELSE}
135 if Control.ClassName = 'TMenuItemWin' then begin
136 Result := THackMenuItemWin(Control).FMenuItem;
137 Assert((Result = nil) or (Result is TMenuItem{TNT-ALLOW TMenuItem}), 'TNT Internal Error: Unexpected TMenuItem field layout.');
138 end
139 {$ENDIF}
140 else if DoVerify then
141 raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.')
142 else
143 Result := nil;
144end;
145
146procedure SetMenuItem(Control: TWinControl; Item: TMenuItem{TNT-ALLOW TMenuItem});
147begin
148 {$IFDEF MNUBUILD_AVAILABLE}
149 if Control is TMenuItemWin then
150 TMenuItemWin(Control).MenuItem := Item
151 {$ELSE}
152 if Control.ClassName = 'TMenuItemWin' then begin
153 THackMenuItemWin(Control).FMenuItem := Item;
154 Item.FreeNotification(Control);
155 end
156 {$ENDIF}
157 else
158 raise Exception.Create('TNT Internal Error: Control is not a TMenuItemWin.');
159end;
160
161procedure ReplaceMenuItem(Control: TWinControl; ANewItem: TMenuItem{TNT-ALLOW TMenuItem});
162var
163 OldItem: TMenuItem{TNT-ALLOW TMenuItem};
164 OldName: string{TNT-ALLOW string};
165begin
166 OldItem := GetMenuItem(Control, True);
167 Assert(OldItem <> nil);
168 OldName := OldItem.Name;
169 FreeAndNil(OldItem);
170 ANewItem.Name := OldName; { assume old name }
171 SetMenuItem(Control, ANewItem);
172end;
173
174{ TTntMenuBuilderChecker }
175
176type
177 TMenuBuilderChecker = class(TComponent)
178 private
179 FMenuBuilder: TForm{TNT-ALLOW TForm};
180 FCheckMenuAction: TTntAction;
181 FLastCaption: string{TNT-ALLOW string};
182 FLastActiveControl: TControl;
183 FLastMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
184 procedure CheckMenuItems(Sender: TObject);
185 public
186 constructor Create(AOwner: TComponent); override;
187 destructor Destroy; override;
188 end;
189
190var MenuBuilderChecker: TMenuBuilderChecker = nil;
191
192constructor TMenuBuilderChecker.Create(AOwner: TComponent);
193begin
194 inherited;
195 MenuBuilderChecker := Self;
196 FCheckMenuAction := TTntAction.Create(Self);
197 FCheckMenuAction.OnUpdate := CheckMenuItems;
198 FCheckMenuAction.OnExecute := CheckMenuItems;
199 FMenuBuilder := AOwner as TForm{TNT-ALLOW TForm};
200 FMenuBuilder.Action := FCheckMenuAction;
201end;
202
203destructor TMenuBuilderChecker.Destroy;
204begin
205 FMenuBuilder := nil;
206 MenuBuilderChecker := nil;
207 inherited;
208end;
209
210type TAccessTntMenuItem = class(TTntMenuItem);
211
212function CreateTntMenuItem(OldItem: TMenuItem{TNT-ALLOW TMenuItem}): TTntMenuItem;
213var
214 OldName: AnsiString;
215 OldParent: TMenuItem{TNT-ALLOW TMenuItem};
216 OldIndex: Integer;
217 OldItemsList: TList;
218 j: integer;
219begin
220 // item should be converted.
221 OldItemsList := TList.Create;
222 try
223 // clone properties
224 Result := TTntMenuItem.Create(OldItem.Owner);
225 TAccessTntMenuItem(Result).FComponentStyle := OldItem.ComponentStyle; {csTransient hides item from object inspector}
226 Result.Action := OldItem.Action;
227 Result.AutoCheck := OldItem.AutoCheck;
228 Result.AutoHotkeys := OldItem.AutoHotkeys;
229 Result.AutoLineReduction := OldItem.AutoLineReduction;
230 Result.Bitmap := OldItem.Bitmap;
231 Result.Break := OldItem.Break;
232 Result.Caption := OldItem.Caption;
233 Result.Checked := OldItem.Checked;
234 Result.Default := OldItem.Default;
235 Result.Enabled := OldItem.Enabled;
236 Result.GroupIndex := OldItem.GroupIndex;
237 Result.HelpContext := OldItem.HelpContext;
238 Result.Hint := OldItem.Hint;
239 Result.ImageIndex := OldItem.ImageIndex;
240 Result.MenuIndex := OldItem.MenuIndex;
241 Result.RadioItem := OldItem.RadioItem;
242 Result.ShortCut := OldItem.ShortCut;
243 Result.SubMenuImages := OldItem.SubMenuImages;
244 Result.Visible := OldItem.Visible;
245 Result.Tag := OldItem.Tag;
246
247 // clone events
248 Result.OnAdvancedDrawItem := OldItem.OnAdvancedDrawItem;
249 Result.OnClick := OldItem.OnClick;
250 Result.OnDrawItem := OldItem.OnDrawItem;
251 Result.OnMeasureItem := OldItem.OnMeasureItem;
252
253 // remember name, parent, index, children
254 OldName := OldItem.Name;
255 OldParent := OldItem.Parent;
256 OldIndex := OldItem.MenuIndex;
257 for j := OldItem.Count - 1 downto 0 do begin
258 OldItemsList.Insert(0, OldItem.Items[j]);
259 OldItem.Remove(OldItem.Items[j]);
260 end;
261
262 // clone final parts of old item
263 for j := 0 to OldItemsList.Count - 1 do
264 Result.Add(TMenuItem{TNT-ALLOW TMenuItem}(OldItemsList[j])); { add children }
265 if OldParent <> nil then
266 OldParent.Insert(OldIndex, Result); { insert into parent }
267 finally
268 OldItemsList.Free;
269 end;
270end;
271
272procedure CheckMenuItemWin(MenuItemWin: TWinControl; PartOfATntMenu: Boolean);
273var
274 OldItem: TMenuItem{TNT-ALLOW TMenuItem};
275begin
276 OldItem := GetMenuItem(MenuItemWin);
277 if OldItem = nil then
278 exit;
279 if (OldItem.ClassType = TMenuItem{TNT-ALLOW TMenuItem})
280 and (PartOfATntMenu or (OldItem.Parent is TTntMenuItem)) then
281 begin
282 if MenuItemWin.Focused then
283 MenuItemWin.Parent.SetFocus; {Lose focus and regain later to ensure object inspector gets updated.}
284 ReplaceMenuItem(MenuItemWin, CreateTntMenuItem(OldItem));
285 end else if (OldItem.ClassType = TTntMenuItem)
286 and (OldItem.Parent = nil) and (OldItem.Caption = '') and (OldItem.Name = '')
287 and not (PartOfATntMenu or (OldItem.Parent is TTntMenuItem)) then begin
288 if MenuItemWin.Focused then
289 MenuItemWin.Parent.SetFocus; {Lose focus and regain later to ensure object inspector gets updated.}
290 ReplaceMenuItem(MenuItemWin, TMenuItem{TNT-ALLOW TMenuItem}.Create(OldItem.Owner));
291 end;
292end;
293
294procedure TMenuBuilderChecker.CheckMenuItems(Sender: TObject);
295var
296 a, i: integer;
297 MenuWin: TWinControl;
298 MenuItemWin: TWinControl;
299 SaveFocus: HWND;
300 PartOfATntMenu: Boolean;
301 WorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
302begin
303 if (FMenuBuilder <> nil)
304 and (FMenuBuilder.Action = FCheckMenuAction) then begin
305 if (FLastCaption <> FMenuBuilder.Caption)
306 or (FLastActiveControl <> FMenuBuilder.ActiveControl)
307 or (FLastMenuItem <> GetMenuItem(FMenuBuilder.ActiveControl, False))
308 then begin
309 try
310 try
311 with FMenuBuilder do begin
312 WorkMenu := GetMenuBuilder_WorkMenu(FMenuBuilder);
313 PartOfATntMenu := (WorkMenu <> nil)
314 and ((WorkMenu.Owner is TTntMainMenu) or (WorkMenu.Owner is TTntPopupMenu));
315 SaveFocus := Windows.GetFocus;
316 for a := ComponentCount - 1 downto 0 do begin
317 {$IFDEF MNUBUILD_AVAILABLE}
318 if Components[a] is TMenuWin then begin
319 {$ELSE}
320 if Components[a].ClassName = 'TMenuWin' then begin
321 {$ENDIF}
322 MenuWin := Components[a] as TWinControl;
323 with MenuWin do begin
324 for i := ComponentCount - 1 downto 0 do begin
325 {$IFDEF MNUBUILD_AVAILABLE}
326 if Components[i] is TMenuItemWin then begin
327 {$ELSE}
328 if Components[i].ClassName = 'TMenuItemWin' then begin
329 {$ENDIF}
330 MenuItemWin := Components[i] as TWinControl;
331 CheckMenuItemWin(MenuItemWin, PartOfATntMenu);
332 end;
333 end;
334 end;
335 end;
336 end;
337 if SaveFocus <> Windows.GetFocus then
338 Windows.SetFocus(SaveFocus);
339 end;
340 except
341 on E: Exception do begin
342 FMenuBuilder.Action := nil;
343 end;
344 end;
345 finally
346 FLastCaption := FMenuBuilder.Caption;
347 FLastActiveControl := FMenuBuilder.ActiveControl;
348 FLastMenuItem := GetMenuItem(FMenuBuilder.ActiveControl, False);
349 end;
350 end;
351 end;
352end;
353
354{ TTntMenuEditor }
355
356function TTntMenuEditor.GetVerbCount: Integer;
357begin
358 Result := 1;
359end;
360
361{$IFNDEF MNUBUILD_AVAILABLE}
362resourcestring
363 SMenuDesigner = 'Menu Designer...';
364{$ENDIF}
365
366function TTntMenuEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
367begin
368 Result := SMenuDesigner;
369end;
370
371procedure TTntMenuEditor.ExecuteVerb(Index: Integer);
372var
373 MenuBuilder: TForm{TNT-ALLOW TForm};
374begin
375 EditPropertyWithDialog(Component, 'Items', Designer);
376 MenuBuilder := GetMenuBuilder;
377 if Assigned(MenuBuilder) then begin
378 if (MenuBuilderChecker = nil) or (MenuBuilderChecker.FMenuBuilder <> MenuBuilder) then begin
379 MenuBuilderChecker.Free;
380 MenuBuilderChecker := TMenuBuilderChecker.Create(MenuBuilder);
381 end;
382 EditPropertyWithDialog(Component, 'Items', Designer); // update menu builder caption
383 end;
384end;
385
386initialization
387
388finalization
389 MenuBuilderChecker.Free; // design package might be recompiled
390
391end.
Note: See TracBrowser for help on using the repository browser.