home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Doc / MENUS.INT < prev    next >
Encoding:
Text File  |  1999-08-11  |  12.7 KB  |  318 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Menus;
  11.  
  12. {$S-,W-,R-,T-,H+,X+}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Contnrs, Messages, Graphics, ImgList, ActnList;
  18.  
  19. type
  20.   TMenuItem = class;
  21.  
  22.   EMenuError = class(Exception);
  23.   TMenu = class;
  24.   TMenuBreak = (mbNone, mbBreak, mbBarBreak);
  25.   TMenuChangeEvent = procedure (Sender: TObject; Source: TMenuItem; Rebuild: Boolean) of object;
  26.   TMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  27.     ARect: TRect; Selected: Boolean) of object;
  28.   TAdvancedMenuDrawItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  29.     ARect: TRect; State: TOwnerDrawState) of object;
  30.   TMenuMeasureItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  31.     var Width, Height: Integer) of object;
  32.   TMenuItemAutoFlag = (maAutomatic, maManual, maParent);
  33.   TMenuAutoFlag = maAutomatic..maManual;
  34.  
  35. { TMenuActionLink }
  36.  
  37.   TMenuActionLink = class(TActionLink)
  38.   protected
  39.     FClient: TMenuItem;
  40.     procedure AssignClient(AClient: TObject); override;
  41.     function IsCaptionLinked: Boolean; override;
  42.     function IsCheckedLinked: Boolean; override;
  43.     function IsEnabledLinked: Boolean; override;
  44.     function IsHelpContextLinked: Boolean; override;
  45.     function IsHintLinked: Boolean; override;
  46.     function IsImageIndexLinked: Boolean; override;
  47.     function IsShortCutLinked: Boolean; override;
  48.     function IsVisibleLinked: Boolean; override;
  49.     function IsOnExecuteLinked: Boolean; override;
  50.     procedure SetCaption(const Value: string); override;
  51.     procedure SetChecked(Value: Boolean); override;
  52.     procedure SetEnabled(Value: Boolean); override;
  53.     procedure SetHelpContext(Value: THelpContext); override;
  54.     procedure SetHint(const Value: string); override;
  55.     procedure SetImageIndex(Value: Integer); override;
  56.     procedure SetShortCut(Value: TShortCut); override;
  57.     procedure SetVisible(Value: Boolean); override;
  58.     procedure SetOnExecute(Value: TNotifyEvent); override;
  59.   end;
  60.  
  61.   TMenuActionLinkClass = class of TMenuActionLink;
  62.  
  63. { TMenuItem }
  64.  
  65.   TMenuItem = class(TComponent)
  66.   protected
  67.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  68.     procedure AdvancedDrawItem(ACanvas: TCanvas; ARect: TRect;
  69.       State: TOwnerDrawState; TopLevel: Boolean); virtual;
  70.     procedure AssignTo(Dest: TPersistent); override;
  71.     procedure DefineProperties(Filer: TFiler); override;
  72.     procedure DoDrawText(ACanvas: TCanvas; const ACaption: string;
  73.       var Rect: TRect; Selected: Boolean; Flags: Longint);
  74.     procedure DrawItem(ACanvas: TCanvas; ARect: TRect; Selected: Boolean); virtual;
  75.     function GetActionLinkClass: TMenuActionLinkClass; dynamic;
  76.     function GetHandle: HMENU;
  77.     function GetCount: Integer;
  78.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  79.     function GetItem(Index: Integer): TMenuItem;
  80.     function GetMenuIndex: Integer;
  81.     function GetAutoHotkeys: Boolean;
  82.     function GetAutoLineReduction: Boolean;
  83.     function InsertNewLine(ABefore: Boolean; AItem: TMenuItem): Integer;
  84.     procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
  85.     procedure MenuChanged(Rebuild: Boolean); virtual;
  86.     procedure Loaded; override;
  87.     procedure Notification(AComponent: TComponent;
  88.       Operation: TOperation); override;
  89.     procedure SetBreak(Value: TMenuBreak);
  90.     procedure SetCaption(const Value: string);
  91.     procedure SetChecked(Value: Boolean);
  92.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  93.     procedure SetDefault(Value: Boolean);
  94.     procedure SetEnabled(Value: Boolean);
  95.     procedure SetGroupIndex(Value: Byte);
  96.     procedure SetImageIndex(Value: TImageIndex);
  97.     procedure SetMenuIndex(Value: Integer);
  98.     procedure SetParentComponent(Value: TComponent); override;
  99.     procedure SetRadioItem(Value: Boolean);
  100.     procedure SetShortCut(Value: TShortCut);
  101.     procedure SetVisible(Value: Boolean);
  102.     procedure UpdateItems;
  103.     property ActionLink: TMenuActionLink;
  104.   public
  105.     constructor Create(AOwner: TComponent); override;
  106.     destructor Destroy; override;
  107.     procedure InitiateAction; virtual;
  108.     procedure Insert(Index: Integer; Item: TMenuItem);
  109.     procedure Delete(Index: Integer);
  110.     procedure Clear;
  111.     procedure Click; virtual;
  112.     function Find(ACaption: string): TMenuItem;
  113.     function IndexOf(Item: TMenuItem): Integer;
  114.     function IsLine: Boolean;
  115.     function GetImageList: TCustomImageList;
  116.     function GetParentComponent: TComponent; override;
  117.     function GetParentMenu: TMenu;
  118.     function HasParent: Boolean; override;
  119.     function NewTopLine: Integer;
  120.     function NewBottomLine: Integer;
  121.     function InsertNewLineBefore(AItem: TMenuItem): Integer;
  122.     function InsertNewLineAfter(AItem: TMenuItem): Integer;
  123.     procedure Add(Item: TMenuItem); overload;
  124.     procedure Add(const AItems: array of TMenuItem); overload;
  125.     procedure Remove(Item: TMenuItem);
  126.     function RethinkHotkeys: Boolean;
  127.     function RethinkLines: Boolean;
  128.     property Command: Word;
  129.     property Handle: HMENU;
  130.     property Count: Integer;
  131.     property Items[Index: Integer]: TMenuItem; default;
  132.     property MenuIndex: Integer;
  133.     property Parent: TMenuItem;
  134.   published
  135.     property Action: TBasicAction;
  136.     property AutoHotkeys: TMenuItemAutoFlag default maParent;
  137.     property AutoLineReduction: TMenuItemAutoFlag default maParent;
  138.     property Bitmap: TBitmap;
  139.     property Break: TMenuBreak default mbNone;
  140.     property Caption: string;
  141.     property Checked: Boolean default False;
  142.     property SubMenuImages: TCustomImageList;
  143.     property Default: Boolean default False;
  144.     property Enabled: Boolean default True;
  145.     property GroupIndex: Byte default 0;
  146.     property HelpContext: THelpContext default 0;
  147.     property Hint: string;
  148.     property ImageIndex: TImageIndex default -1;
  149.     property RadioItem: Boolean default False;
  150.     property ShortCut: TShortCut default 0;
  151.     property Visible: Boolean default True;
  152.     property OnClick: TNotifyEvent;
  153.     property OnDrawItem: TMenuDrawItemEvent;
  154.     property OnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
  155.     property OnMeasureItem: TMenuMeasureItemEvent;
  156.   end;
  157.  
  158.   TFindItemKind = (fkCommand, fkHandle, fkShortCut);
  159.  
  160.   TMenu = class(TComponent)
  161.   protected
  162.     procedure AdjustBiDiBehavior;
  163.     procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
  164.     procedure DoBiDiModeChanged;
  165.     function DoGetMenuString(Menu: HMENU; ItemID: UINT; Str: PChar;
  166.       MaxCount: Integer; Flag: UINT): Integer;
  167.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  168.     function GetHandle: HMENU; virtual;
  169.     function IsOwnerDraw: Boolean;
  170.     procedure Loaded; override;
  171.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); virtual;
  172.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  173.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  174.     procedure UpdateItems;
  175.     property OnChange: TMenuChangeEvent;
  176.   public
  177.     constructor Create(AOwner: TComponent); override;
  178.     destructor Destroy; override;
  179.     function DispatchCommand(ACommand: Word): Boolean;
  180.     function DispatchPopup(AHandle: HMENU): Boolean;
  181.     function FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
  182.     function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
  183.     property Images: TCustomImageList;
  184.     function IsRightToLeft: Boolean;
  185.     function IsShortCut(var Message: TWMKey): Boolean; dynamic;
  186.     procedure ParentBiDiModeChanged; overload;
  187.     procedure ParentBiDiModeChanged(AControl: TObject); overload;
  188.     procedure ProcessMenuChar(var Message: TWMMenuChar);
  189.     property AutoHotkeys: TMenuAutoFlag default maAutomatic;
  190.     property AutoLineReduction: TMenuAutoFlag default maAutomatic;
  191.     property BiDiMode: TBiDiMode;
  192.     property Handle: HMENU;
  193.     property OwnerDraw: Boolean default False;
  194.     property ParentBiDiMode: Boolean default True;
  195.     property WindowHandle: HWND;
  196.   published
  197.     property Items: TMenuItem;
  198.   end;
  199.  
  200.   TMainMenu = class(TMenu)
  201.   protected
  202.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  203.     function GetHandle: HMENU; override;
  204.   public
  205.     procedure Merge(Menu: TMainMenu);
  206.     procedure Unmerge(Menu: TMainMenu);
  207.     procedure PopulateOle2Menu(SharedMenu: HMenu; Groups: array of Integer;
  208.       var Widths: array of Longint);
  209.     procedure GetOle2AcceleratorTable(var AccelTable: HAccel;
  210.       var AccelCount: Integer; Groups: array of Integer);
  211.     procedure SetOle2MenuHandle(Handle: HMENU);
  212.   published
  213.     property AutoHotkeys;
  214.     property AutoLineReduction;
  215.     property AutoMerge: Boolean default False;
  216.     property BiDiMode;
  217.     property Images;
  218.     property OwnerDraw;
  219.     property ParentBiDiMode;
  220.     property OnChange;
  221.   end;
  222.  
  223.   TPopupAlignment = (paLeft, paRight, paCenter);
  224.   TTrackButton = (tbRightButton, tbLeftButton);
  225.   TMenuAnimations = (maLeftToRight, maRightToLeft, maTopToBottom, maBottomToTop, maNone);
  226.   TMenuAnimation = set of TMenuAnimations;
  227.  
  228.   TPopupMenu = class(TMenu)
  229.   protected
  230.     function UseRightToLeftAlignment: Boolean;
  231.     procedure DoPopup(Sender: TObject); virtual;
  232.     property PopupPoint: TPoint;
  233.   public
  234.     constructor Create(AOwner: TComponent); override;
  235.     destructor Destroy; override;
  236.     procedure Popup(X, Y: Integer); virtual;
  237.     property PopupComponent: TComponent;
  238.   published
  239.     property Alignment: TPopupAlignment default paLeft;
  240.     property AutoHotkeys;
  241.     property AutoLineReduction;
  242.     property AutoPopup: Boolean default True;
  243.     property BiDiMode;
  244.     property HelpContext: THelpContext default 0;
  245.     property Images;
  246.     property MenuAnimation: TMenuAnimation default [];
  247.     property OwnerDraw;
  248.     property ParentBiDiMode;
  249.     property TrackButton: TTrackButton default tbRightButton;
  250.     property OnChange;
  251.     property OnPopup: TNotifyEvent;
  252.   end;
  253.  
  254.   TPopupList = class(TList)
  255.   protected
  256.     FWindow: HWND;
  257.     procedure MainWndProc(var Message: TMessage);
  258.     procedure WndProc(var Message: TMessage); virtual;
  259.   public
  260.     property Window: HWND;
  261.     procedure Add(Popup: TPopupMenu);
  262.     procedure Remove(Popup: TPopupMenu);
  263.   end;
  264.  
  265.   PMenuItem = ^TMenuItem;
  266.  
  267.   TMenuItemStack = class(TStack)
  268.   public
  269.     procedure ClearItem(AItem: TMenuItem);
  270.   end;
  271.  
  272. var
  273.   PopupList: TPopupList;
  274.   ShortCutItems: TMenuItemStack;
  275.  
  276. function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
  277. procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
  278. function ShortCutToText(ShortCut: TShortCut): string;
  279. function TextToShortCut(Text: string): TShortCut;
  280.  
  281. function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
  282. function NewPopupMenu(Owner: TComponent; const AName: string;
  283.   Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuitem): TPopupMenu;
  284. function NewSubMenu(const ACaption: string; hCtx: Word;
  285.   const AName: string; Items: array of TMenuItem; AEnabled: Boolean = True): TMenuItem;
  286. function NewItem(const ACaption: string; AShortCut: TShortCut;
  287.   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  288.   const AName: string): TMenuItem;
  289. function NewLine: TMenuItem;
  290.  
  291. procedure DrawMenuItem(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect;
  292.   State: TOwnerDrawState);
  293.  
  294. var
  295.   { These are the hotkeys that the auto-hotkey system will pick from.
  296.     Change this global variable at runtime if you want to add or remove
  297.     characters from the available characters.  Notice that by default we
  298.     do not do international characters. }
  299.   ValidMenuHotkeys: string = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'; { do not localize }
  300.  
  301. const
  302.   cHotkeyPrefix = '&';
  303.   cLineCaption = '-';
  304.   cDialogSuffix = '...';
  305.  
  306. { StripHotkey removes the & escape char that marks the hotkey character(s) in
  307.   the string.  When the current locale is a Far East locale, this function also
  308.   looks for and removes parens around the hotkey, common in Far East locales. }
  309. function StripHotkey(const Text: string): string;
  310.  
  311. { GetHotkey will return the last hotkey that StripHotkey would strip. }
  312. function GetHotkey(const Text: string): string;
  313.  
  314. { Similar to AnsiSameText but strips hotkeys before comparing }
  315. function AnsiSameCaption(const Text1, Text2: string): Boolean;
  316.  
  317. implementation
  318.