PageRenderTime 35ms CodeModel.GetById 18ms app.highlight 7ms RepoModel.GetById 1ms app.codeStats 1ms

/designer/menueditorform.pas

http://github.com/graemeg/lazarus
Pascal | 1007 lines | 881 code | 90 blank | 36 comment | 99 complexity | 6225c33ad49339f1ceea7e1f8a4a972e MD5 | raw file
   1{***************************************************************************
   2 *                                                                         *
   3 *   This source is free software; you can redistribute it and/or modify   *
   4 *   it under the terms of the GNU General Public License as published by  *
   5 *   the Free Software Foundation; either version 2 of the License, or     *
   6 *   (at your option) any later version.                                   *
   7 *                                                                         *
   8 *   This code is distributed in the hope that it will be useful, but      *
   9 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
  10 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
  11 *   General Public License for more details.                              *
  12 *                                                                         *
  13 *   A copy of the GNU General Public License is available on the World    *
  14 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
  15 *   obtain it by writing to the Free Software Foundation,                 *
  16 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
  17 *                                                                         *
  18 ***************************************************************************
  19
  20  Author: Howard Page-Clark }
  21
  22unit MenuEditorForm;
  23
  24{$mode objfpc}{$H+}
  25
  26interface
  27
  28uses
  29  // FCL + LCL
  30  Classes, SysUtils, Types, typinfo,
  31  Controls, StdCtrls, ExtCtrls, Forms, Graphics, Buttons, Menus, ButtonPanel,
  32  ImgList, Themes, LCLintf, LCLProc,
  33  // IdeIntf
  34  FormEditingIntf, PropEdits,
  35  // IDE
  36  LazarusIDEStrConsts, MenuDesignerBase, MenuShortcuts;
  37
  38type
  39
  40  { TMenuDesignerForm }
  41
  42  TMenuDesignerForm = class(TForm)
  43    AddItemAboveButton: TSpeedButton;
  44    AddItemBelowButton: TSpeedButton;
  45    AddSeparatorAboveButton: TSpeedButton;
  46    AddSeparatorBelowButton: TSpeedButton;
  47    AddSubMenuButton: TSpeedButton;
  48    ButtonsGroupBox: TGroupBox;
  49    CaptionedItemsCountLabel: TLabel;
  50    DeepestNestingLevelLabel: TLabel;
  51    DeleteItemButton: TSpeedButton;
  52    GroupIndexLabel: TLabel;
  53    HelpButton: TBitBtn;
  54    IconCountLabel: TLabel;
  55    LeftPanel: TPanel;
  56    MoveItemDownButton: TSpeedButton;
  57    MoveItemUpButton: TSpeedButton;
  58    PopupAssignmentsCountLabel: TLabel;
  59    RadioGroupsLabel: TLabel;
  60    ShortcutItemsCountLabel: TLabel;
  61    StatisticsGroupBox: TGroupBox;
  62    SubmenuGroupBox: TGroupBox;
  63    procedure FormCreate(Sender: TObject);
  64    procedure FormDestroy(Sender: TObject);
  65    procedure HelpButtonClick(Sender: TObject);
  66  strict private
  67    FDesigner: TMenuDesignerBase;
  68    FEditedMenu: TMenu;
  69    FAcceleratorMenuItemsCount: integer;
  70    FCaptionedItemsCount: integer;
  71    FDeepestNestingLevel: integer;
  72    FAddingItem: Boolean;
  73    FGUIEnabled: boolean;
  74    FIconsCount: integer;
  75    FUpdateCount: integer;
  76    FPopupAssignments: TStringList;
  77    FPopupAssignmentsListBox: TListBox;
  78    function GetItemCounts(out aCaptionedItemCount, aShortcutItemCount,
  79                           anIconCount, anAccelCount: integer): integer;
  80    function GetPopupAssignmentCount: integer;
  81    function GetSelectedMenuComponent(const aSelection: TPersistentSelectionList;
  82      out isTMenu: boolean; out isTMenuItem: boolean): TPersistent;
  83    procedure DisableGUI;
  84    procedure EnableGUI(selectedIsNil: boolean);
  85    procedure HidePopupAssignmentsInfo;
  86    procedure InitializeStatisticVars;
  87    procedure LoadFixedButtonGlyphs;
  88    procedure OnDesignerSetSelection(const ASelection: TPersistentSelectionList);
  89    procedure ProcessForPopup(aControl: TControl);
  90    procedure SetupPopupAssignmentsDisplay;
  91  public
  92    constructor Create(aDesigner: TMenuDesignerBase); reintroduce;
  93    destructor Destroy; override;
  94    procedure LoadVariableButtonGlyphs(isInMenubar: boolean);
  95    procedure SetMenu(aMenu: TMenu; aMenuItem: TMenuItem);
  96    procedure ShowPopupAssignmentsInfo;
  97    procedure BeginUpdate;
  98    procedure EndUpdate;
  99    function IsUpdate: Boolean;
 100    procedure UpdateStatistics;
 101    procedure UpdateSubmenuGroupBox(selMI: TMenuItem; selBox: TShadowBoxBase; boxIsRoot:boolean);
 102    procedure UpdateItemInfo(aMenu: TMenu; aMenuItem: TMenuItem;
 103      aShadowBox: TShadowBoxBase; aPropEditHook: TPropertyEditorHook);
 104    //property EditedMenu: TMenu read FEditedMenu;
 105    //property AcceleratorMenuItemsCount: integer read FAcceleratorMenuItemsCount;
 106    property AddingItem: Boolean read FAddingItem write FAddingItem;
 107  end;
 108
 109  TRadioIconGroup = class;
 110  TRadioIconState = (risUp, risDown, risPressed, risUncheckedHot, risCheckedHot);
 111
 112  { TRadioIcon }
 113
 114  TRadioIcon = class(TGraphicControl)
 115  strict private
 116    FBGlyph: TButtonGlyph;
 117    FOnChange: TNotifyEvent;
 118    FRIGroup: TRadioIconGroup;
 119    FRIState: TRadioIconState;
 120    function GetChecked: Boolean;
 121    procedure SetChecked(aValue: Boolean);
 122  protected
 123    procedure DoChange;
 124    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
 125    procedure MouseEnter; override;
 126    procedure MouseLeave; override;
 127    procedure Paint; override;
 128  public
 129    constructor CreateWithGlyph(aRIGroup: TRadioIconGroup; anImgIndex: integer);
 130    destructor Destroy; override;
 131    property Checked: Boolean read GetChecked write SetChecked;
 132    property OnChange: TNotifyEvent read FOnChange write FOnChange;
 133  end;
 134
 135  { TRadioIconGroup }
 136
 137  TRadioIconGroup = class(TScrollBox)
 138  strict private
 139    FItemIndex: integer;
 140    FOnSelectItem: TNotifyEvent;
 141    FRIArray: array of TRadioIcon;
 142    procedure CreateRadioItems;
 143    procedure ApplyLayout;
 144    procedure RIOnChange(Sender: TObject);
 145    procedure DoSelectItem;
 146  protected
 147    FImageList: TCustomImageList;
 148    FedSize: TSize;
 149    FedUnchecked, FedChecked, FedPressed, FedUncheckedHot, FedCheckedHot: TThemedElementDetails;
 150    FGlyphPt: TPoint;
 151    FSpacing: integer;
 152    FRadioHeight, FRadioWidth: integer;
 153    FRadioRect: TRect;
 154    procedure SetParent(NewParent: TWinControl); override;
 155  public
 156    constructor CreateWithImageList(AOwner: TComponent; anImgList: TCustomImageList);
 157    property ItemIndex: integer read FItemIndex;
 158    property OnSelectItem: TNotifyEvent read FOnSelectItem write FOnSelectItem;
 159  end;
 160
 161  { TdlgChooseIcon }
 162
 163  TdlgChooseIcon = class(TForm)
 164  private
 165    FButtonPanel: TButtonPanel;
 166    FRadioIconGroup: TRadioIconGroup;
 167    function GetImageIndex: integer;
 168    procedure RIGClick(Sender: TObject);
 169  public
 170    constructor Create(TheOwner: TComponent); override;
 171    procedure SetRadioIconGroup(anImageList: TCustomImageList);
 172    property ImageIndex: integer read GetImageIndex;
 173  end;
 174
 175function GetNestingLevelDepth(aMenu: TMenu): integer;
 176function ChooseIconFromImageListDlg(anImageList: TCustomImageList): integer;
 177
 178
 179implementation
 180
 181{$R *.lfm}
 182
 183function GetNestingLevelDepth(aMenu: TMenu): integer;
 184
 185  procedure CheckLevel(aMI: TMenuItem; aLevel: integer);
 186  var
 187    j: integer;
 188  begin
 189    if (aMI.Count > 0) then begin
 190      if (Succ(aLevel) > Result) then
 191        Result:=Succ(aLevel);
 192      for j:=0 to aMI.Count-1 do
 193        CheckLevel(aMI.Items[j], Succ(aLevel));
 194    end;
 195  end;
 196
 197var
 198  i: integer;
 199begin
 200  Result:=0;
 201  for i:=0 to aMenu.Items.Count-1 do
 202    CheckLevel(aMenu.Items[i], 0);
 203end;
 204
 205function ChooseIconFromImageListDlg(anImageList: TCustomImageList): integer;
 206var
 207  dlg: TdlgChooseIcon;
 208begin
 209  if (anImageList = nil) or (anImageList.Count = 0) then
 210    Exit(-1);
 211  if (anImageList.Count = 1) then
 212    Exit(0);
 213  dlg := TdlgChooseIcon.Create(nil);
 214  try
 215    dlg.SetRadioIconGroup(anImageList);
 216    if (dlg.ShowModal = mrOK) then
 217      Result := dlg.ImageIndex
 218    else
 219      Result := -1;
 220  finally
 221    dlg.Free;
 222  end;
 223end;
 224
 225{ TMenuDesignerForm }
 226
 227constructor TMenuDesignerForm.Create(aDesigner: TMenuDesignerBase);
 228begin
 229  Inherited Create(Nil);  // LazarusIDE.OwningComponent
 230  FDesigner := aDesigner;
 231end;
 232
 233destructor TMenuDesignerForm.Destroy;
 234begin
 235  inherited Destroy;
 236end;
 237
 238procedure TMenuDesignerForm.FormCreate(Sender: TObject);
 239begin
 240  Name:='MenuDesignerWindow';
 241  Caption:=lisMenuEditorMenuEditor;
 242  ButtonsGroupBox.Caption:=lisMenuEditorMenuItemActions;
 243  FGUIEnabled:=False;
 244  LoadFixedButtonGlyphs;
 245  LoadVariableButtonGlyphs(True);
 246  KeyPreview:=True;
 247  GlobalDesignHook.AddHandlerSetSelection(@OnDesignerSetSelection);
 248  InitializeStatisticVars;
 249  SetupPopupAssignmentsDisplay;
 250end;
 251
 252procedure TMenuDesignerForm.FormDestroy(Sender: TObject);
 253begin
 254  FreeAndNil(FPopupAssignments);
 255end;
 256
 257procedure TMenuDesignerForm.HelpButtonClick(Sender: TObject);
 258const
 259  helpPath = 'http://wiki.lazarus.freepascal.org/IDE_Window:_Menu_Editor';
 260begin
 261  //LazarusHelp.ShowHelpForIDEControl(Self);
 262  OpenURL(helpPath);
 263end;
 264
 265procedure TMenuDesignerForm.OnDesignerSetSelection(const ASelection: TPersistentSelectionList);
 266var
 267  mnu: TMenu;
 268  mi, tmp: TMenuItem;
 269  isTMenu, isTMenuItem: boolean;
 270  persist: TPersistent;
 271begin
 272  if FUpdateCount > 0 then
 273    Exit; // This event will be executed after all updates, look at EndUpdate
 274
 275  persist:=GetSelectedMenuComponent(ASelection, isTMenu, isTMenuItem);
 276  if (persist <> nil) then
 277  begin
 278    if isTMenu then
 279      SetMenu(TMenu(persist), nil)
 280    else if isTMenuItem then begin
 281      mi:=TMenuItem(persist);
 282      tmp:=mi;
 283      while (tmp.Parent <> nil) do
 284        tmp:=tmp.Parent;
 285      mnu:=tmp.Menu;
 286      if (mnu = nil) then
 287        mnu:=mi.GetParentMenu;
 288      if (mnu = FEditedMenu) and (FDesigner.ShadowMenu <> nil) then
 289        FDesigner.ShadowMenu.SetSelectedMenuItem(mi, True, False)
 290      else if (mnu <> nil) then
 291        SetMenu(mnu, mi);
 292    end;
 293  end
 294  else if not AddingItem then
 295    SetMenu(nil, nil);
 296end;
 297
 298procedure TMenuDesignerForm.ShowPopupAssignmentsInfo;
 299var
 300  count: integer;
 301begin
 302  if (FEditedMenu <> nil) and (FEditedMenu is TPopupMenu) then begin
 303    count:=GetPopupAssignmentCount;
 304    PopupAssignmentsCountLabel.Enabled:=True;
 305    if (count > 0) then
 306      PopupAssignmentsCountLabel.BorderSpacing.Bottom:=0
 307    else
 308      PopupAssignmentsCountLabel.BorderSpacing.Bottom:=Double_Margin;
 309    if (count= -1) then
 310      PopupAssignmentsCountLabel.Caption:=Format(lisMenuEditorPopupAssignmentsS,[lisMenuEditorNA])
 311    else
 312      PopupAssignmentsCountLabel.Caption:=Format(lisMenuEditorPopupAssignmentsS, [IntToStr(count)]);
 313    if (count > 0) then begin
 314      FPopupAssignmentsListBox.Items.Assign(FPopupAssignments);
 315      FPopupAssignmentsListBox.Visible:=True;
 316    end
 317    else
 318      FPopupAssignmentsListBox.Visible:=False;
 319  end;
 320end;
 321
 322procedure TMenuDesignerForm.HidePopupAssignmentsInfo;
 323begin
 324  if (FEditedMenu <> nil) and (FEditedMenu is TMainMenu) then begin
 325    PopupAssignmentsCountLabel.Caption:=Format(lisMenuEditorPopupAssignmentsS,[lisMenuEditorNA]);
 326    PopupAssignmentsCountLabel.Enabled:=False;
 327    FPopupAssignmentsListBox.Visible:=False;
 328  end;
 329end;
 330
 331procedure TMenuDesignerForm.SetupPopupAssignmentsDisplay;
 332begin
 333  FPopupAssignmentsListBox:=TListBox.Create(Self);
 334  with FPopupAssignmentsListBox do begin
 335    Name:='FPopupAssignmentsListBox';
 336    Color:=clBtnFace;
 337    BorderSpacing.Top:=2;
 338    BorderSpacing.Left:=3*Margin;
 339    BorderSpacing.Right:=Margin;
 340    BorderSpacing.Bottom:=Margin;
 341    Anchors:=[akTop, akLeft, akRight];
 342    AnchorSideLeft.Control:=StatisticsGroupBox;
 343    AnchorSideTop.Control:=PopupAssignmentsCountLabel;
 344    AnchorSideTop.Side:=asrBottom;
 345    AnchorSideRight.Control:=StatisticsGroupBox;
 346    AnchorSideRight.Side:=asrBottom;
 347    ParentFont:=False;
 348    TabStop:=False;
 349    BorderStyle:=bsNone;
 350    ExtendedSelect:=False;
 351    Height:=45;
 352    Parent:=StatisticsGroupBox;
 353    Visible:=False;
 354  end;
 355end;
 356
 357function TMenuDesignerForm.GetItemCounts(out aCaptionedItemCount,
 358  aShortcutItemCount, anIconCount, anAccelCount: integer): integer;
 359var
 360  imgCount: integer;
 361
 362  procedure ProcessItems(aMI: TMenuItem);
 363  var
 364    i: integer;
 365    sc: TShortCut;
 366  begin
 367    Inc(Result);
 368    if not aMI.IsLine and (aMI.Caption <> '') then begin
 369      Inc(aCaptionedItemCount);
 370      if HasAccelerator(aMI.Caption, sc) then
 371        Inc(anAccelCount);
 372    end;
 373    if (aMI.ShortCut <> 0) or (aMI.ShortCutKey2 <> 0) then
 374      Inc(aShortcutItemCount);
 375    if (imgCount > 0) and (aMI.ImageIndex > -1) and (aMI.ImageIndex < imgCount) then
 376      Inc(anIconCount)
 377    else if aMI.HasBitmap and not aMI.Bitmap.Empty then
 378      Inc(anIconCount);
 379    for i:=0 to aMI.Count-1 do
 380      ProcessItems(aMI.Items[i]);   // Recursive call for sub-menus.
 381  end;
 382
 383var
 384  i: integer;
 385begin
 386  if (FEditedMenu = nil) then
 387    Exit;
 388  aCaptionedItemCount:=0;
 389  aShortcutItemCount:=0;
 390  anIconCount:=0;
 391  anAccelCount:=0;
 392  if (FEditedMenu.Images <> nil) and (FEditedMenu.Images.Count > 0) then
 393    imgCount:=FEditedMenu.Images.Count
 394  else
 395    imgCount:=0;
 396  Result:=0;
 397  for i:=0 to FEditedMenu.Items.Count-1 do
 398    ProcessItems(FEditedMenu.Items[i]);
 399end;
 400
 401function TMenuDesignerForm.GetSelectedMenuComponent(const aSelection: TPersistentSelectionList;
 402                                out isTMenu: boolean; out isTMenuItem: boolean): TPersistent;
 403begin
 404  if (aSelection.Count = 1) then begin
 405    if (aSelection.Items[0] is TMenu) then
 406      begin
 407        isTMenu:=True;
 408        isTMenuItem:=False;
 409        Result:=aSelection.Items[0];
 410      end
 411    else
 412    if (aSelection.Items[0] is TMenuItem) then
 413      begin
 414        isTMenu:=False;
 415        isTMenuItem:=True;
 416        Result:=aSelection.Items[0];
 417      end
 418    else begin
 419      isTMenu:=False;
 420      isTMenuItem:=False;
 421      Result:=nil;
 422    end;
 423  end
 424  else
 425    Result:=nil;
 426end;
 427
 428procedure TMenuDesignerForm.ProcessForPopup(aControl: TControl);
 429var
 430  wc: TWinControl;
 431  j:integer;
 432begin
 433  if (aControl.PopupMenu = FEditedMenu) and (aControl.Name <> '') then
 434    FPopupAssignments.Add(aControl.Name);
 435  if (aControl is TWinControl) then begin
 436    wc:=TWinControl(aControl);
 437    for j:=0 to wc.ControlCount-1 do
 438      ProcessForPopup(wc.Controls[j]);   // Recursive call
 439  end;
 440end;
 441
 442function TMenuDesignerForm.GetPopupAssignmentCount: integer;
 443var
 444  lookupRoot: TPersistent;
 445begin
 446  lookupRoot:=GlobalDesignHook.LookupRoot;
 447  if (FEditedMenu is TMainMenu) or (lookupRoot is TDataModule) then
 448    Exit(-1)
 449  else begin
 450    FreeAndNil(FPopupAssignments);
 451    FPopupAssignments:=TStringList.Create;
 452    ProcessForPopup(lookupRoot as TControl);
 453    Result:=FPopupAssignments.Count;
 454  end
 455end;
 456
 457procedure TMenuDesignerForm.LoadVariableButtonGlyphs(isInMenubar: boolean);
 458begin
 459  if isInMenubar then
 460  begin
 461    MoveItemUpButton.LoadGlyphFromResourceName(HINSTANCE,'arrow_left');
 462    MoveItemDownButton.LoadGlyphFromResourceName(HINSTANCE,'arrow_right');
 463    AddItemAboveButton.LoadGlyphFromResourceName(HINSTANCE,'add_item_left');
 464    AddItemBelowButton.LoadGlyphFromResourceName(HINSTANCE,'add_item_right');
 465    AddSubMenuButton.LoadGlyphFromResourceName(HINSTANCE,'add_submenu_below');
 466  end else
 467  begin
 468    MoveItemUpButton.LoadGlyphFromResourceName(HINSTANCE,'arrow_up');
 469    MoveItemDownButton.LoadGlyphFromResourceName(HINSTANCE,'arrow_down');
 470    AddItemAboveButton.LoadGlyphFromResourceName(HINSTANCE,'add_item_above');
 471    AddItemBelowButton.LoadGlyphFromResourceName(HINSTANCE,'add_item_below');
 472    AddSubMenuButton.LoadGlyphFromResourceName(HINSTANCE,'add_submenu_right');
 473  end;
 474  UpdateSubmenuGroupBox(nil, nil, False);
 475  FDesigner.VariableGlyphsInMenuBar:=isInMenubar;
 476end;
 477
 478procedure TMenuDesignerForm.LoadFixedButtonGlyphs;
 479begin
 480  DeleteItemButton.LoadGlyphFromResourceName(HINSTANCE,'laz_delete');
 481  AddSeparatorAboveButton.LoadGlyphFromResourceName(HINSTANCE,'add_sep_above');
 482  AddSeparatorBelowButton.LoadGlyphFromResourceName(HINSTANCE,'add_sep_below');
 483  HelpButton.Hint:=lisMenuEditorGetHelpToUseThisEditor;
 484end;
 485
 486procedure TMenuDesignerForm.EnableGUI(selectedIsNil: boolean);
 487var
 488  isPopupMenu: boolean;
 489begin
 490  if not FGUIEnabled then
 491    begin
 492      StatisticsGroupBox.Font.Style:=[fsBold];
 493      StatisticsGroupBox.Caption:=FEditedMenu.Name;
 494      StatisticsGroupBox.Enabled:=True;
 495      ButtonsGroupBox.Enabled:=not selectedIsNil;
 496      if selectedIsNil then
 497        Caption:=Format(lisMenuEditorEditingSSNoMenuItemSelected,
 498          [TComponent(GlobalDesignHook.LookupRoot).Name, FEditedMenu.Name]);
 499      isPopupMenu:=(FEditedMenu is TPopupMenu);
 500      LoadVariableButtonGlyphs(not isPopupMenu);
 501      if isPopupMenu then
 502        ShowPopupAssignmentsInfo
 503      else HidePopupAssignmentsInfo;
 504      FGUIEnabled:=True;
 505    end;
 506end;
 507
 508procedure TMenuDesignerForm.InitializeStatisticVars;
 509begin
 510  FDesigner.Shortcuts.ResetMenuItemsCount;
 511  FIconsCount := -1;
 512  FDeepestNestingLevel := -1;
 513  FCaptionedItemsCount := -1;
 514end;
 515
 516procedure TMenuDesignerForm.DisableGUI;
 517begin
 518  if FGUIEnabled then begin
 519    StatisticsGroupBox.Font.Style:=[];
 520    StatisticsGroupBox.Caption:=lisMenuEditorNoMenuSelected;
 521    CaptionedItemsCountLabel.Caption:=Format(lisMenuEditorCaptionedItemsS,[lisMenuEditorNA]);
 522    ShortcutItemsCountLabel.Caption:=Format(lisMenuEditorShortcutItemsS,[lisMenuEditorNA]);
 523    IconCountLabel.Caption:=Format(lisMenuEditorItemsWithIconS, [lisMenuEditorNA]);
 524    DeepestNestingLevelLabel.Caption:=Format(lisMenuEditorDeepestNestedMenuLevelS, [lisMenuEditorNA]);
 525    PopupAssignmentsCountLabel.Caption:=Format(lisMenuEditorPopupAssignmentsS,[lisMenuEditorNA]);
 526    StatisticsGroupBox.Enabled:=False;
 527    UpdateSubmenuGroupBox(nil, nil, False);
 528    ButtonsGroupBox.Enabled:=False;
 529    FPopupAssignmentsListBox.Visible:=False;
 530    FGUIEnabled:=False;
 531    InitializeStatisticVars;
 532    Caption:=Format('%s - %s',[lisMenuEditorMenuEditor, lisMenuEditorNoMenuSelected]);
 533  end;
 534end;
 535
 536procedure TMenuDesignerForm.SetMenu(aMenu: TMenu; aMenuItem: TMenuItem);
 537var
 538  selection: TMenuItem;
 539begin
 540  if (aMenu = nil) then
 541  begin
 542    DisableGUI;
 543    FDesigner.FreeShadowMenu;
 544    FEditedMenu:=nil;
 545  end
 546  else begin
 547    if (aMenu = FEditedMenu) and (FDesigner.ShadowMenu <> nil) then
 548      FDesigner.ShadowMenu.SetSelectedMenuItem(aMenuItem, True, False)
 549    else begin
 550      if (aMenu = FEditedMenu) and (FDesigner.ShadowMenu = nil) then
 551      begin
 552        if (FEditedMenu.Items.Count > 0) then
 553          selection := FEditedMenu.Items[0]
 554        else
 555          selection := nil;
 556      end
 557      else if (aMenu <> FEditedMenu) then
 558      begin
 559        FDesigner.ShadowMenu.Free;
 560        FDesigner.ShadowMenu := Nil;
 561        FEditedMenu := aMenu;
 562        selection := aMenuItem;
 563      end;
 564
 565      FGUIEnabled := False;
 566      EnableGUI(selection = nil);
 567      UpdateStatistics;
 568      FDesigner.CreateShadowMenu(FEditedMenu, selection, Width-LeftPanel.Width, Height);
 569    end;
 570  end;
 571end;
 572
 573procedure TMenuDesignerForm.BeginUpdate;
 574begin
 575  Inc(FUpdateCount);
 576end;
 577
 578procedure TMenuDesignerForm.EndUpdate;
 579begin
 580  if FUpdateCount<=0 then
 581    RaiseGDBException('');
 582  Dec(FUpdateCount);
 583  if FUpdateCount = 0 then
 584    OnDesignerSetSelection(FormEditingHook.GetCurrentObjectInspector.Selection);
 585end;
 586
 587function TMenuDesignerForm.IsUpdate: Boolean;
 588begin
 589  Result := FUpdateCount > 0;
 590end;
 591
 592procedure TMenuDesignerForm.UpdateStatistics;
 593var
 594  captions, shrtcuts, icons, accels, tmp: integer;
 595  s: String;
 596begin
 597  if not SameText(StatisticsGroupBox.Caption, FEditedMenu.Name) then
 598    StatisticsGroupBox.Caption:=FEditedMenu.Name;
 599
 600  FDesigner.TotalMenuItemsCount:=GetItemCounts(captions, shrtcuts, icons, accels);
 601  if (FCaptionedItemsCount <> captions) then begin
 602    FCaptionedItemsCount:=captions;
 603    CaptionedItemsCountLabel.Caption:=
 604      Format(lisMenuEditorCaptionedItemsS, [IntToStr(captions)]);
 605  end;
 606  s:=FDesigner.Shortcuts.Statistics(shrtcuts);
 607  if s <> '' then
 608    ShortcutItemsCountLabel.Caption := s;
 609  if (FIconsCount <> icons) then begin
 610    FIconsCount:=icons;
 611    IconCountLabel.Caption:=
 612      Format(lisMenuEditorItemsWithIconS, [IntToStr(FIconsCount)]);
 613  end;
 614  if (FAcceleratorMenuItemsCount <> accels) then
 615    FAcceleratorMenuItemsCount:=accels;
 616  tmp:=GetNestingLevelDepth(FEditedMenu);
 617  if (FDeepestNestingLevel <> tmp) then begin
 618    DeepestNestingLevelLabel.Caption:=
 619      Format(lisMenuEditorDeepestNestedMenuLevelS, [IntToStr(tmp)]);
 620    FDeepestNestingLevel:=tmp;
 621  end;
 622  StatisticsGroupBox.Invalidate;
 623end;
 624
 625procedure TMenuDesignerForm.UpdateSubmenuGroupBox(selMI: TMenuItem;
 626  selBox: TShadowBoxBase; boxIsRoot: boolean);
 627begin
 628  if SubmenuGroupBox = nil then
 629    Exit;
 630
 631  if (selMI = nil) then begin
 632    SubmenuGroupBox.Caption:=lisMenuEditorNoMenuSelected;
 633    RadioGroupsLabel.Caption:='';
 634    GroupIndexLabel.Caption:='';
 635  end
 636  else begin
 637    selBox.LastRIValue:=selMI.RadioItem;
 638    if boxIsRoot then
 639      SubmenuGroupBox.Caption:=lisMenuEditorRootMenu
 640    else SubmenuGroupBox.Caption:=Format(lisMenuEditorSSubmenu,[selBox.ParentMenuItem.Name]);
 641
 642    if selMI.RadioItem then begin
 643      GroupIndexLabel.Caption:=Format(lisMenuEditorSGroupIndexD,
 644                                      [selMI.Name, selMI.GroupIndex]);
 645      GroupIndexLabel.Enabled:=True;
 646    end
 647    else begin
 648      GroupIndexLabel.Caption:=Format(lisMenuEditorSIsNotARadioitem,
 649                                      [selMI.Name]);
 650      GroupIndexLabel.Enabled:=False;
 651    end;
 652
 653    if selBox.HasRadioItems then begin
 654      RadioGroupsLabel.Caption:=Format(lisMenuEditorGroupIndexValueSS,
 655                                       [selBox.RadioGroupsString]);
 656      RadioGroupsLabel.Enabled:=True;
 657    end
 658    else begin
 659      RadioGroupsLabel.Caption:=lisMenuEditorNoRadioitemsInThisMenu;
 660      RadioGroupsLabel.Enabled:=False;
 661      RadioGroupsLabel.Invalidate; //for some reason this seems necessary
 662    end;
 663  end;
 664end;
 665
 666procedure TMenuDesignerForm.UpdateItemInfo(aMenu: TMenu; aMenuItem: TMenuItem;
 667  aShadowBox: TShadowBoxBase; aPropEditHook: TPropertyEditorHook);
 668var
 669  s: string;
 670  method: TMethod;
 671begin
 672  if aMenuItem = nil then
 673  begin
 674    Caption:=Format(lisMenuEditorEditingSSNoMenuitemSelected,
 675                    [aMenu.Owner.Name, aMenu.Name]);
 676    ButtonsGroupBox.Enabled:=False;
 677    UpdateSubmenuGroupBox(nil, nil, False);
 678  end
 679  else begin
 680    method:=GetMethodProp(aMenuItem, 'OnClick');
 681    s:=aPropEditHook.GetMethodName(method, aMenuItem);
 682    if s = '' then
 683      s:=lisMenuEditorIsNotAssigned;
 684    Caption:=Format(lisMenuEditorSSSOnClickS,
 685                    [aMenu.Owner.Name, aMenu.Name, aMenuItem.Name, s]);
 686    ButtonsGroupBox.Enabled:=True;
 687    UpdateSubmenuGroupBox(aMenuItem, aShadowBox, aShadowBox.Level=0);
 688  end;
 689end;
 690
 691{ TRadioIcon }
 692
 693constructor TRadioIcon.CreateWithGlyph(aRIGroup: TRadioIconGroup;
 694  anImgIndex: integer);
 695begin
 696  Assert(anImgIndex > -1, 'TRadioIcon.CreateWithGlyph: param not > -1');
 697  inherited Create(aRIGroup);
 698  FRIGroup:=aRIGroup;
 699
 700  FBGlyph:=TButtonGlyph.Create;
 701  FBGlyph.IsDesigning:=False;
 702  FBGlyph.ShowMode:=gsmAlways;
 703  FBGlyph.OnChange:=nil;
 704  FBGlyph.CacheSetImageList(FRIGroup.FImageList);
 705  FBGlyph.CacheSetImageIndex(0, anImgIndex);
 706  Tag:=anImgIndex;
 707
 708  SetInitialBounds(0, 0, FRIGroup.FRadioWidth, FRIGroup.FRadioHeight);
 709  ControlStyle:=ControlStyle + [csCaptureMouse]-[csSetCaption, csClickEvents, csOpaque];
 710  FRIState:=risUp;
 711  Color:=clBtnFace;
 712end;
 713
 714destructor TRadioIcon.Destroy;
 715begin
 716  FreeAndNil(FBGlyph);
 717  inherited Destroy;
 718end;
 719
 720function TRadioIcon.GetChecked: Boolean;
 721begin
 722  Result:=FRIState in [risDown, risPressed, risCheckedHot];
 723end;
 724
 725procedure TRadioIcon.SetChecked(aValue: Boolean);
 726begin
 727  case aValue of
 728    True: if (FRIState <> risDown) then begin // set to True
 729            FRIState:=risDown;
 730            Repaint;
 731          end;
 732    False: if (FRIState <> risUp) then begin // set to False
 733             FRIState:=risUp;
 734             Repaint;
 735           end;
 736  end;
 737end;
 738
 739procedure TRadioIcon.DoChange;
 740begin
 741  if Assigned(FOnChange) then
 742    FOnChange(Self);
 743end;
 744
 745procedure TRadioIcon.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 746begin
 747  inherited MouseDown(Button, Shift, X, Y);
 748  if (Button = mbLeft) and (FRIState in [risUncheckedHot, risUp]) then begin
 749    FRIState:=risPressed;
 750    Repaint;
 751    DoChange;
 752  end;
 753end;
 754
 755procedure TRadioIcon.MouseEnter;
 756begin
 757  inherited MouseEnter;
 758  case FRIState of
 759    risUp: FRIState:=risUncheckedHot;
 760    risDown: FRIState:=risCheckedHot;
 761  end;
 762  Repaint;
 763end;
 764
 765procedure TRadioIcon.MouseLeave;
 766begin
 767  case FRIState of
 768    risPressed, risCheckedHot: FRIState:=risDown;
 769    risUncheckedHot:           FRIState:=risUp;
 770  end;
 771  Repaint;
 772  inherited MouseLeave;
 773end;
 774
 775procedure TRadioIcon.Paint;
 776var
 777  ted: TThemedElementDetails;
 778begin
 779  if (Canvas.Brush.Color <> Color) then
 780    Canvas.Brush.Color:=Color;
 781  Canvas.FillRect(ClientRect);
 782  case FRIState of
 783    risUp:           ted:=FRIGroup.FedUnchecked;
 784    risDown:         ted:=FRIGroup.FedChecked;
 785    risPressed:      ted:=FRIGroup.FedPressed;
 786    risUncheckedHot: ted:=FRIGroup.FedUncheckedHot;
 787    risCheckedHot:   ted:=FRIGroup.FedCheckedHot;
 788  end;
 789  ThemeServices.DrawElement(Canvas.Handle, ted, FRIGroup.FRadioRect);
 790  FBGlyph.Draw(Canvas, ClientRect, FRIGroup.FGlyphPt, bsUp, False, 0);
 791
 792  inherited Paint;
 793end;
 794
 795{ TRadioIconGroup }
 796
 797constructor TRadioIconGroup.CreateWithImageList(AOwner: TComponent;
 798  anImgList: TCustomImageList);
 799var
 800  topOffset: integer;
 801begin
 802  Assert(AOwner<>nil,'TRadioIconGroup.CreateWithImageList: AOwner is nil');
 803  Assert(anImgList<>nil,'TRadioIconGroup.CreateWithImageList:anImgList is nil');
 804
 805  inherited Create(AOwner);
 806  FImageList:=anImgList;
 807  FedUnChecked:=ThemeServices.GetElementDetails(tbRadioButtonUncheckedNormal);
 808  FedChecked:=ThemeServices.GetElementDetails(tbRadioButtonCheckedNormal);
 809  FedPressed:=ThemeServices.GetElementDetails(tbRadioButtonCheckedPressed);
 810  FedUncheckedHot:=ThemeServices.GetElementDetails(tbRadioButtonUncheckedHot);
 811  FedCheckedHot:=ThemeServices.GetElementDetails(tbRadioButtonCheckedHot);
 812  FedSize:=ThemeServices.GetDetailSize(FedUnChecked);
 813  FRadioHeight:=FedSize.cy;
 814  if (anImgList.Height > FRadioHeight) then
 815    FRadioHeight:=anImgList.Height;
 816  topOffset:=(FRadioHeight - FedSize.cy) div 2;
 817  FRadioRect:=Rect(0, topOffset, FedSize.cx, topOffset+FedSize.cy);
 818  FSpacing:=5;
 819  FRadioWidth:=FedSize.cx + FSpacing + anImgList.Width;
 820  FGlyphPt:=Point(FedSize.cx+FSpacing, 0);
 821  FItemIndex:= -1;
 822  CreateRadioItems;
 823end;
 824
 825procedure TRadioIconGroup.CreateRadioItems;
 826var
 827  i: integer;
 828begin
 829  SetLength(FRIArray, FImageList.Count);
 830  for i:=Low(FRIArray) to High(FRIArray) do
 831    begin
 832      FRIArray[i]:=TRadioIcon.CreateWithGlyph(Self, i);
 833      FRIArray[i].OnChange:=@RIOnChange;
 834    end;
 835end;
 836
 837procedure TRadioIconGroup.ApplyLayout;
 838var
 839  unitArea, hSpace, sepn, count, cols, rows, lastRowCount, space, h, num, denom: integer;
 840
 841  procedure CalcSepn;
 842  begin
 843    rows:=count div cols;
 844    if (cols*rows < count) or (rows < 2) then
 845      Inc(rows);
 846    lastRowCount:=count mod cols;
 847    if (lastRowCount = 0) then
 848      lastRowCount:=cols;
 849    num:=space + hSpace*FRIArray[0].Height - lastRowCount*unitArea;
 850    denom:=Pred(rows)*hSpace + FRIArray[0].Height*Pred(cols)*Pred(rows);
 851    Assert(denom > 0,'TRadioIconGroup.ApplyLayout: divisor is zero');
 852    sepn:=trunc(num/denom);
 853    repeat
 854      Dec(sepn);
 855      h:=cols*FRIArray[0].Width + Pred(cols)*sepn;
 856    until (h < hSpace) or (sepn <= Margin);
 857  end;
 858
 859const
 860  BPanelVertDim = 46;
 861var
 862  areaToFill, hBorderAndMargins, vSpace, vSepn, oldCols,
 863    i, v, gap, hInc, vInc, maxIdx, vBorderAndMargins: integer;
 864  lft: integer = Margin;
 865  tp: integer = Margin;
 866  r: integer = 1;
 867  c: integer = 1;
 868begin
 869  hBorderAndMargins:=integer(BorderSpacing.Left)+integer(BorderSpacing.Right)+integer(BorderSpacing.Around*2) + Double_Margin;
 870  hSpace:=Parent.ClientWidth - hBorderAndMargins;
 871  vBorderAndMargins:=integer(BorderSpacing.Top)+integer(BorderSpacing.Bottom)+integer(BorderSpacing.Around*2) + Double_Margin;
 872  vSpace:=Parent.ClientHeight - vBorderAndMargins - BPanelVertDim;
 873  areaToFill:=hSpace*vSpace;
 874  unitArea:=FRIArray[0].Width*FRIArray[0].Height;
 875  count:=Length(FRIArray);
 876  space:=areaToFill - count*unitArea;
 877
 878  cols:=trunc(sqrt(count)); // assume area is roughly square
 879  if (cols = 0) then
 880    Inc(cols);
 881  oldCols:=cols;
 882  CalcSepn;
 883
 884  gap:=hSpace - h;
 885  if (gap > 0) and (gap > FRIArray[0].Width) then
 886  begin
 887    Inc(cols);
 888    CalcSepn;
 889  end;
 890  if (sepn <= Margin) then
 891  begin
 892    cols:=oldcols;
 893    CalcSepn;
 894  end;
 895
 896  vSepn:=sepn;
 897  v:=rows*FRIArray[0].Height + Pred(rows)*vSepn;
 898  if (v > vSpace) then
 899  repeat
 900    Dec(vSepn);
 901    v:=rows*FRIArray[0].Height + Pred(rows)*vSepn;
 902  until (v < vSpace) or (vSepn <= Margin);
 903
 904  hInc:=FRIArray[0].Width + sepn;
 905  vInc:=FRIArray[0].Height + vSepn;
 906  maxIdx:=High(FRIArray);
 907  for i:=Low(FRIArray) to maxIdx do
 908  begin
 909    FRIArray[i].Left:=lft;
 910    FRIArray[i].Top:=tp;
 911    Inc(c);
 912    Inc(lft, hInc);
 913    if (c > cols) and (i < maxIdx) then
 914    begin
 915      c:=1;
 916      lft:=Margin;
 917      Inc(r);
 918      Inc(tp, vInc);
 919    end;
 920  end;
 921  Assert(r <= rows,'TRadioIconGroup.ApplyLayout: error in calculation of space needed');
 922end;
 923
 924procedure TRadioIconGroup.RIOnChange(Sender: TObject);
 925var
 926  aRi: TRadioIcon;
 927  i: integer;
 928begin
 929  if not (Sender is TRadioIcon) then
 930    Exit;
 931  aRi:=TRadioIcon(Sender);
 932  FItemIndex:=aRi.Tag;
 933  DoSelectItem;
 934  if aRi.Checked then
 935  begin
 936   for i:=Low(FRIArray) to High(FRIArray) do
 937     if (i <> FItemIndex) then
 938       FRIArray[i].Checked:=False;
 939  end;
 940end;
 941
 942procedure TRadioIconGroup.DoSelectItem;
 943begin
 944  if Assigned(FOnSelectItem) then
 945    FOnSelectItem(Self);
 946end;
 947
 948procedure TRadioIconGroup.SetParent(NewParent: TWinControl);
 949var
 950  i: Integer;
 951begin
 952  inherited SetParent(NewParent);
 953  if (NewParent <> nil) then
 954  begin
 955    ApplyLayout;
 956    for i:=Low(FRIArray) to High(FRIArray) do
 957      FRIArray[i].SetParent(Self);
 958  end;
 959end;
 960
 961{ TdlgChooseIcon }
 962
 963constructor TdlgChooseIcon.Create(TheOwner: TComponent);
 964begin
 965  inherited CreateNew(TheOwner);
 966  Position:=poScreenCenter;
 967  BorderStyle:=bsDialog;
 968  Width:=250;
 969  Height:=250;
 970  FButtonPanel:=TButtonPanel.Create(Self);
 971  FButtonPanel.ShowButtons:=[pbOK, pbCancel];
 972  FButtonPanel.OKButton.Name:='OKButton';
 973  FButtonPanel.OKButton.DefaultCaption:=True;
 974  FButtonPanel.OKButton.Enabled:=False;
 975  FButtonPanel.CancelButton.Name:='CancelButton';
 976  FButtonPanel.CancelButton.DefaultCaption:=True;
 977  FButtonPanel.Parent:=Self;
 978end;
 979
 980function TdlgChooseIcon.GetImageIndex: integer;
 981begin
 982  Result:=FRadioIconGroup.ItemIndex;
 983end;
 984
 985procedure TdlgChooseIcon.RIGClick(Sender: TObject);
 986begin
 987  FButtonPanel.OKButton.Enabled:=True;
 988  FButtonPanel.OKButton.SetFocus;
 989end;
 990
 991procedure TdlgChooseIcon.SetRadioIconGroup(anImageList: TCustomImageList);
 992begin
 993  FRadioIconGroup:=TRadioIconGroup.CreateWithImageList(Self, anImageList);
 994  with FRadioIconGroup do begin
 995    Align:=alClient;
 996    BorderSpacing.Top:=FButtonPanel.BorderSpacing.Around;
 997    BorderSpacing.Left:=FButtonPanel.BorderSpacing.Around;
 998    BorderSpacing.Right:=FButtonPanel.BorderSpacing.Around;
 999    TabOrder:=0;
1000    OnSelectItem:=@RIGClick;
1001    Parent:=Self;
1002  end;
1003  Caption:=Format(lisMenuEditorPickAnIconFromS, [anImageList.Name]);
1004end;
1005
1006end.
1007