cmpmenudesigner.pas

學習資料網上下載

(*===========================================================================*
 | unit cmpMenuDesigner                                                      |
 |                                                                           |
 | Menu Designer Component                                                   |
 |                                                                           |
 | Version  Date      By    Description                                      |
 | -------  --------  ----  -------------------------------------------------|
 | 1.0      05/07/00  CPWW  Original                                         |
 *===========================================================================*)

unit cmpMenuDesigner;

interface

uses
  Windows, Messages, Menus, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type

//=============================================================================
// TBaseMenuDesigner class.  Base class for TMenuDesigner and TPopupMenuDesigner
//
// NB.  Tags is used to hold the menu item ID.  If it's selected then Tags is
//      -(menu item ID + 3)
//
// NB.  Each time an item is selected, the path to it is save in the fPositionSnapshot
//      list.  If SetItems is called with the 'KeepPosition flag set', the item at the
//      snapshot position will be selected.
//
// NB.  We should really use 'TMenuItem.Command' to hold this - but we can't set it because it's
//      read-only.

  TDesignerMenuItem = class (TMenuItem)
  private
    function GetID: Integer;
    procedure SetID(const Value: Integer);
    function GetSelected: boolean;
    procedure SetSelected(const Value: boolean);
  protected
    procedure MenuChanged(Rebuild: Boolean); override;
  public
    property ID : Integer read GetID write SetID;
    property Selected : boolean read GetSelected write SetSelected;
  end;

  TBaseMenuDesigner = class (TCustomControl)
  private
    fItems: TMenuItem;
    fSelectedItem: TMenuItem;
    fOnSelectedItemChange: TNotifyEvent;
    fDirty : boolean;
    fPositionSnapshot : TList;
    procedure PaintItems (x, y : Integer; items : TMenuItem);
    procedure CalcItemsSize (items : TMenuItem; var stW, shortcutW, h : Integer);
    function DrawTextWidth (lm, rm : Integer; const st : string) : Integer;
    procedure SetSelectedItem(const Value: TMenuItem);
    procedure WmGetDLGCode (var msg : TwmGetDlgCode); message WM_GETDLGCODE;
    procedure DoChangeSelectedItem (value : TMenuItem);

    function AddChildItemAt (parent : TMenuItem; index : Integer) : TMenuItem;
    procedure TakeSnapshot;
    function GetSnapshotItem : TMenuItem;
    function GetSelectedItem: TMenuItem;

    function DrawItem (item : TMenuITem; x, y, stw, shw, leftMargin, rightMargin, sth : Integer; vert : boolean) : Integer;
    { Private declarations }
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;

    function ItemAt (X, Y : Integer) : TMenuItem; virtual;
    function ItemAtOffset (items : TMenuItem; XOffset, YOffset, X, Y : Integer) : TMenuItem;
    procedure CalcSize (var w, h : Integer); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoExit; override;
    procedure DoEnter; override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    property Items : TMenuItem read fItems;
    property SelectedItem : TMenuItem read GetSelectedItem write SetSelectedItem;
    procedure DeleteItem (item : TMenuItem);

    function InsertItem (beforeItem : TMenuItem) : TMenuItem;
    function AppendItem (afterItem : TMenuItem) : TMenuItem;
    function AddChildItem (parentItem : TMenuItem) : TMenuItem;

    procedure RestoreTags;

    property Dirty : boolean read fDirty;
    procedure SetItems(const Value: TMenuItem; keepPosition : boolean = False);

  published
    property OnSelectedItemChange : TNotifyEvent read fOnSelectedItemChange write fOnSelectedItemChange;
    property Align;
    property Anchors;
    property AutoSize;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnKeyUp;
    property OnKeyPress;
    property OnKeyDown;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TMenuDesigner = class(TBaseMenuDesigner)
  private
    { Private declarations }
  protected
    procedure Paint; override;
    function ItemAt (X, Y : Integer) : TMenuItem; override;
    procedure CalcSize (var w, h : Integer); override;
  public
    constructor Create (AOwner : TComponent); override;
  published
  end;

  TPopupMenuDesigner = class (TBaseMenuDesigner)
  private
    { Private declarations }
  protected
    procedure Paint; override;
    function ItemAt (X, Y : Integer) : TMenuItem; override;
    procedure CalcSize (var w, h : Integer); override;
  public
    constructor Create (AOwner : TComponent); override;
  published
    { Published declarations }
  end;

  TMenuItemDesigner = class (TCustomControl)
  end;

function ExtractCaption (const st : string) : string;
function ExtractShortcut (const st : string) : string;
function MergeCaption (const st, shortcut : string) : string;

implementation

{ TBaseMenuDesigner }

const
  menuLeftMargin = 16;
  menuRightMargin = 16;
  menuTopMargin = 5;
  menuBottomMargin = 5;

  mainMenuLeftMargin = 7;
  mainMenuRightMargin = 7;

function ExtractCaption (const st : string) : string;
var
  p : Integer;
begin
  result := st;
  p := Pos (#9, result);
  if p > 0 then
    result := Copy (result, 1, p - 1)
end;

function ExtractShortcut (const st : string) : string;
var
  p : Integer;
begin
  result := st;
  p := Pos (#9, result);
  if p > 0 then
    result := Copy (result, p + 1, MaxInt)
  else
    result := ''
end;

function MergeCaption (const st, shortcut : string) : string;
begin
  if shortcut <> '' then
    result := st + #9 + shortcut
  else
    result := st
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.AddChildItem()                                     |
 |                                                                      |
 | Add a sub-menu.                                                      |
 |                                                                      |
 | Parameters                                                           |
 |    parentItem : TMenuItem          The parent of the new child menu  |
 *----------------------------------------------------------------------*)
function TBaseMenuDesigner.AddChildItem(parentItem: TMenuItem): TMenuItem;
begin
  result := AddChildItemAt (parentItem, parentItem.Count);
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.AddChildItemAt ()                                  |
 |                                                                      |
 | Add a child item at the specified position.  Private                 |
 |                                                                      |
 | Parameters                                                           |
 |   parent : TMenuItem         The parent of the new child item        |
 |   index : Integer            Position of the child item.             |
 *----------------------------------------------------------------------*)
function TBaseMenuDesigner.AddChildItemAt(parent : TMenuItem; index: Integer): TMenuItem;
begin
  if Assigned (parent) then
  begin
    result := TDesignerMenuItem.Create (self);
    parent.Insert (index, result);
    SelectedItem := result;
    Invalidate
  end
  else
    result := Nil
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.AppendItem()                                       |
 |                                                                      |
 | Append an item to a menu.                                            |
 |                                                                      |
 | Parameters                                                           |
 |    afterItem : TMenuItem          The item to insert after           |
 *----------------------------------------------------------------------*)
function TBaseMenuDesigner.AppendItem(afterItem: TMenuItem): TMenuItem;
var
  idx : Integer;
begin
  if Assigned (afterItem) and Assigned (afterItem.Parent) then
  begin
    idx := afterItem.Parent.IndexOf (afterItem);
    result := AddChildItemAt (afterItem.parent, idx + 1)
  end
  else
    result := Nil
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.CalcItemsSize                                      |
 |                                                                      |
 | Calculate the width & height of a pop-up or child menu               |
 |                                                                      |
 | The height is the height of each item + the top margin + the bottom  |
 | margin.                                                              |
 |                                                                      |
 | Both the widest item text width and widest shortcut text width are   |
 | returned.  Each of these is the left margin, the right margin and    |
 | the width of the text.  This implies that the separation between the |
 | text and shortcut text is the left margin + the right margin.        |
 |                                             |                        |
 | Parameters                                                           |
 |    items : TMenuItem         The items to evaluate                   |
 |    var stW : Integer         The widest text width                   |
 |    var shortcutW : Integer   The widest shortcut width               |
 |    var h : Integer           The hieght of th menu.                  |
 *----------------------------------------------------------------------*)
procedure TBaseMenuDesigner.CalcItemsSize (items: TMenuItem; var stW, shortcutW, h : Integer);
var
  st, s1 : string;
  i, w0, w1, lh : Integer;

begin
  inherited;

  stW := 0;
  shortcutW := 0;
  h := menuTopMargin + menuBottomMargin;
  lh := GetSystemMetrics (SM_CYMENU);

  for i := 0 to Items.Count - 1 do
  begin
    st := ExtractCaption (items.Items [i].Caption);
    s1 := ExtractShortcut (items.Items [i].Caption);

    if st <> '-' then
    begin
      if s1 <> '' then  // Calculate the shortcut width
      begin
        w1 := DrawTextWidth (menuLeftMargin, menuRightMargin, s1);
        if w1 > shortcutW then
          shortcutW := w1
      end;

                        // Calculate the text width
      w0 := DrawTextWidth (menuLeftMargin, menuRightMargin, st);
    end
    else                // Nominal width for empty item
      w0 := 50 + menuLeftMargin + menuRightMargin;

    if w0 > stW then
      stW := w0;
    Inc (h, lh)
  end
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.CalcSize                                           |
 |                                                                      |
 | Return the width and height of a bounding rectangle that would       |
 | completely cover the fully expanded menu.                            |
 |                                                                      |
 | This is overridden by TMenuDesigner and TPopupMenuDesigner.          |
 *----------------------------------------------------------------------*)
procedure TBaseMenuDesigner.CalcSize(var w, h: Integer);
begin
  w := 0;
  h := 0;
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.CanAutoSize                                        |
 |                                                                      |
 | Returns the width and height to the VCL so alignment/auto-sizing     |
 | works.                                                               |
 *----------------------------------------------------------------------*)
function TBaseMenuDesigner.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
var
  calced : boolean;
  w, h : Integer;
begin
  Result := True;
  if not (csDesigning in ComponentState) then
  begin
    calced := False;
    if Align in [alNone, alLeft, alRight] then
    begin
      CalcSize (w, h);
      calced := True;
      NewWidth := w
    end;

    if Align in [alNone, alTop, alBottom] then
    begin
      if not calced then CalcSize (w, h);
      NewHeight := h
    end
  end
end;

(*----------------------------------------------------------------------*
 | TBaseMenuDesigner.Create ()                                          |
 |                                                                      |
 | Constructor for TBaseMenuDesigner                                    |
 *----------------------------------------------------------------------*)
constructor TBaseMenuDesigner.Create(AOwner: TComponent);
begin
  inherited;