Design/TntMenus_Design.pas

   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
  12 unit 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
  21 interface
  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
  31 uses
  32   Windows, Classes, Menus, Messages,
  33   {$IFDEF MNUBUILD_AVAILABLE} MnuBuild, {$ENDIF}
  34   DesignEditors, DesignIntf;
  35
  36 type
  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
  44 procedure Register;
  45
  46 implementation
  47
  48 uses
  49   {$IFDEF MNUBUILD_AVAILABLE} MnuConst, {$ELSE} DesignWindows, {$ENDIF} SysUtils, Graphics, ActnList,
  50   Controls, Forms, TntDesignEditors_Design, TntActnList, TntMenus;
  51
  52 procedure Register;
  53 begin
  54   RegisterComponentEditor(TTntMainMenu, TTntMenuEditor);
  55   RegisterComponentEditor(TTntPopupMenu, TTntMenuEditor);
  56 end;
  57
  58 function GetMenuBuilder: TForm{TNT-ALLOW TForm};
  59 {$IFDEF MNUBUILD_AVAILABLE}
  60 begin
  61   Result := MenuEditor;
  62 {$ELSE}
  63 var
  64   Comp: TComponent;
  65 begin
  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}
  74 end;
  75
  76 {$IFDEF DELPHI_9} // verified against Delphi 9
  77 type
  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
  87 type
  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
  96 function GetMenuBuilder_WorkMenu(MenuBuilder: TForm{TNT-ALLOW TForm}): TMenuItem{TNT-ALLOW TMenuItem};
  97 begin
  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;
 109 end;
 110
 111 {$IFDEF DELPHI_9} // verified against Delphi 9
 112 type
 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
 121 type
 122   THackMenuItemWin = class(TCustomControl)
 123   protected
 124     FxxxxCaptionExtent: Integer;
 125     FMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
 126   end;
 127 {$ENDIF}
 128
 129 function GetMenuItem(Control: TWinControl; DoVerify: Boolean = True): TMenuItem{TNT-ALLOW TMenuItem};
 130 begin
 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;
 144 end;
 145
 146 procedure SetMenuItem(Control: TWinControl; Item: TMenuItem{TNT-ALLOW TMenuItem});
 147 begin
 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.');
 159 end;
 160
 161 procedure ReplaceMenuItem(Control: TWinControl; ANewItem: TMenuItem{TNT-ALLOW TMenuItem});
 162 var
 163   OldItem: TMenuItem{TNT-ALLOW TMenuItem};
 164   OldName: string{TNT-ALLOW string};
 165 begin
 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);
 172 end;
 173
 174 { TTntMenuBuilderChecker }
 175
 176 type
 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
 190 var MenuBuilderChecker: TMenuBuilderChecker = nil;
 191
 192 constructor TMenuBuilderChecker.Create(AOwner: TComponent);
 193 begin
 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;
 201 end;
 202
 203 destructor TMenuBuilderChecker.Destroy;
 204 begin
 205   FMenuBuilder := nil;
 206   MenuBuilderChecker := nil;
 207   inherited;
 208 end;
 209
 210 type TAccessTntMenuItem = class(TTntMenuItem);
 211
 212 function CreateTntMenuItem(OldItem: TMenuItem{TNT-ALLOW TMenuItem}): TTntMenuItem;
 213 var
 214   OldName: AnsiString;
 215   OldParent: TMenuItem{TNT-ALLOW TMenuItem};
 216   OldIndex: Integer;
 217   OldItemsList: TList;
 218   j: integer;
 219 begin
 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;
 270 end;
 271
 272 procedure CheckMenuItemWin(MenuItemWin: TWinControl; PartOfATntMenu: Boolean);
 273 var
 274   OldItem: TMenuItem{TNT-ALLOW TMenuItem};
 275 begin
 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;
 292 end;
 293
 294 procedure TMenuBuilderChecker.CheckMenuItems(Sender: TObject);
 295 var
 296   a, i: integer;
 297   MenuWin: TWinControl;
 298   MenuItemWin: TWinControl;
 299   SaveFocus: HWND;
 300   PartOfATntMenu: Boolean;
 301   WorkMenu: TMenuItem{TNT-ALLOW TMenuItem};
 302 begin
 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;
 352 end;
 353
 354 { TTntMenuEditor }
 355
 356 function TTntMenuEditor.GetVerbCount: Integer;
 357 begin
 358   Result := 1;
 359 end;
 360
 361 {$IFNDEF MNUBUILD_AVAILABLE}
 362 resourcestring
 363   SMenuDesigner = 'Menu Designer...';
 364 {$ENDIF}
 365
 366 function TTntMenuEditor.GetVerb(Index: Integer): string{TNT-ALLOW string};
 367 begin
 368   Result := SMenuDesigner;
 369 end;
 370
 371 procedure TTntMenuEditor.ExecuteVerb(Index: Integer);
 372 var
 373   MenuBuilder: TForm{TNT-ALLOW TForm};
 374 begin
 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;
 384 end;
 385
 386 initialization
 387
 388 finalization
 389   MenuBuilderChecker.Free; // design package might be recompiled
 390
 391 end.