home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2000 October / tst.iso / programs / borland / RUNIMAGE / DELPHI40 / DOC / MENUS.INT < prev    next >
Encoding:
Text File  |  1998-06-17  |  9.6 KB  |  240 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,98 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Menus;
  11.  
  12. {$S-,W-,R-}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, 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.   TMenuMeasureItemEvent = procedure (Sender: TObject; ACanvas: TCanvas;
  29.     var Width, Height: Integer) of object;
  30.  
  31. { TMenuActionLink }
  32.  
  33.   TMenuActionLink = class(TActionLink)
  34.   protected
  35.     FClient: TMenuItem;
  36.     procedure AssignClient(AClient: TObject); override;
  37.     function IsCaptionLinked: Boolean; override;
  38.     function IsCheckedLinked: Boolean; override;
  39.     function IsEnabledLinked: Boolean; override;
  40.     function IsHelpContextLinked: Boolean; override;
  41.     function IsHintLinked: Boolean; override;
  42.     function IsImageIndexLinked: Boolean; override;
  43.     function IsShortCutLinked: Boolean; override;
  44.     function IsVisibleLinked: Boolean; override;
  45.     function IsOnExecuteLinked: Boolean; override;
  46.     procedure SetCaption(const Value: string); override;
  47.     procedure SetChecked(Value: Boolean); override;
  48.     procedure SetEnabled(Value: Boolean); override;
  49.     procedure SetHelpContext(Value: THelpContext); override;
  50.     procedure SetHint(const Value: string); override;
  51.     procedure SetImageIndex(Value: Integer); override;
  52.     procedure SetShortCut(Value: TShortCut); override;
  53.     procedure SetVisible(Value: Boolean); override;
  54.     procedure SetOnExecute(Value: TNotifyEvent); override;
  55.   end;
  56.  
  57.   TMenuActionLinkClass = class of TMenuActionLink;
  58.  
  59. { TMenuItem }
  60.  
  61.   TMenuItem = class(TComponent)
  62.   protected
  63.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  64.     procedure AssignTo(Dest: TPersistent); override;
  65.     procedure DefineProperties(Filer: TFiler); override;
  66.     procedure DoDrawText(ACanvas: TCanvas; const ACaption: string;
  67.       var Rect: TRect; Selected: Boolean; Flags: Longint);
  68.     procedure DrawItem(ACanvas: TCanvas; ARect: TRect; Selected: Boolean); virtual;
  69.     function GetActionLinkClass: TMenuActionLinkClass; dynamic;
  70.     function GetHandle: HMENU;
  71.     function GetCount: Integer;
  72.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  73.     function GetItem(Index: Integer): TMenuItem;
  74.     function GetMenuIndex: Integer;
  75.     procedure MeasureItem(ACanvas: TCanvas; var Width, Height: Integer);
  76.     procedure MenuChanged(Rebuild: Boolean); virtual;
  77.     procedure Loaded; override;
  78.     procedure Notification(AComponent: TComponent;
  79.       Operation: TOperation); override;
  80.     procedure SetBreak(Value: TMenuBreak);
  81.     procedure SetCaption(const Value: string);
  82.     procedure SetChecked(Value: Boolean);
  83.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  84.     procedure SetDefault(Value: Boolean);
  85.     procedure SetEnabled(Value: Boolean);
  86.     procedure SetGroupIndex(Value: Byte);
  87.     procedure SetImageIndex(Value: Integer);
  88.     procedure SetMenuIndex(Value: Integer);
  89.     procedure SetParentComponent(Value: TComponent); override;
  90.     procedure SetRadioItem(Value: Boolean);
  91.     procedure SetShortCut(Value: TShortCut);
  92.     procedure SetVisible(Value: Boolean);
  93.     property ActionLink: TMenuActionLink;
  94.   public
  95.     constructor Create(AOwner: TComponent); override;
  96.     destructor Destroy; override;
  97.     procedure InitiateAction; virtual;
  98.     procedure Insert(Index: Integer; Item: TMenuItem);
  99.     procedure Delete(Index: Integer);
  100.     procedure Click; virtual;
  101.     function IndexOf(Item: TMenuItem): Integer;
  102.     function GetParentComponent: TComponent; override;
  103.     function GetParentMenu: TMenu;
  104.     function HasParent: Boolean; override;
  105.     procedure Add(Item: TMenuItem);
  106.     procedure Remove(Item: TMenuItem);
  107.     property Command: Word;
  108.     property Handle: HMENU;
  109.     property Count: Integer;
  110.     property Items[Index: Integer]: TMenuItem; default;
  111.     property MenuIndex: Integer;
  112.     property Parent: TMenuItem;
  113.   published
  114.     property Action: TBasicAction;
  115.     property Bitmap: TBitmap;
  116.     property Break: TMenuBreak default mbNone;
  117.     property Caption: string;
  118.     property Checked: Boolean default False;
  119.     property Default: Boolean default False;
  120.     property Enabled: Boolean default True;
  121.     property GroupIndex: Byte default 0;
  122.     property HelpContext: THelpContext default 0;
  123.     property Hint: string;
  124.     property ImageIndex: Integer default -1;
  125.     property RadioItem: Boolean default False;
  126.     property ShortCut: TShortCut default 0;
  127.     property Visible: Boolean default True;
  128.     property OnClick: TNotifyEvent;
  129.     property OnDrawItem: TMenuDrawItemEvent;
  130.     property OnMeasureItem: TMenuMeasureItemEvent;
  131.   end;
  132.  
  133.   TFindItemKind = (fkCommand, fkHandle, fkShortCut);
  134.  
  135.   TMenu = class(TComponent)
  136.   protected
  137.     procedure AdjustBiDiBehavior;
  138.     procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual;
  139.     procedure DoBiDiModeChanged;
  140.     function DoGetMenuString(Menu: HMENU; ItemID: UINT; Str: PChar;
  141.       MaxCount: Integer; Flag: UINT): Integer;
  142.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  143.     function GetHandle: HMENU; virtual;
  144.     function IsOwnerDraw: Boolean;
  145.     procedure Loaded; override;
  146.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); virtual;
  147.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  148.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  149.     procedure UpdateItems;
  150.     property OnChange: TMenuChangeEvent;
  151.   public
  152.     constructor Create(AOwner: TComponent); override;
  153.     destructor Destroy; override;
  154.     function DispatchCommand(ACommand: Word): Boolean;
  155.     function DispatchPopup(AHandle: HMENU): Boolean;
  156.     function FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
  157.     function GetHelpContext(Value: Integer; ByCommand: Boolean): THelpContext;
  158.     property Images: TCustomImageList;
  159.     function IsRightToLeft: Boolean;
  160.     function IsShortCut(var Message: TWMKey): Boolean; dynamic;
  161.     procedure ParentBiDiModeChanged; overload;
  162.     procedure ParentBiDiModeChanged(AControl: TObject); overload;
  163.     procedure ProcessMenuChar(var Message: TWMMenuChar);
  164.     property BiDiMode: TBiDiMode;
  165.     property Handle: HMENU;
  166.     property OwnerDraw: Boolean default False;
  167.     property ParentBiDiMode: Boolean default True;
  168.     property WindowHandle: HWND;
  169.   published
  170.     property Items: TMenuItem;
  171.   end;
  172.  
  173.   TMainMenu = class(TMenu)
  174.   protected
  175.     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  176.     function GetHandle: HMENU; override;
  177.   public
  178.     procedure Merge(Menu: TMainMenu);
  179.     procedure Unmerge(Menu: TMainMenu);
  180.     procedure PopulateOle2Menu(SharedMenu: HMenu; Groups: array of Integer;
  181.       var Widths: array of Longint);
  182.     procedure GetOle2AcceleratorTable(var AccelTable: HAccel;
  183.       var AccelCount: Integer; Groups: array of Integer);
  184.     procedure SetOle2MenuHandle(Handle: HMENU);
  185.   published
  186.     property AutoMerge: Boolean default False;
  187.     property BiDiMode;
  188.     property Images;
  189.     property OwnerDraw;
  190.     property ParentBiDiMode;
  191.     property OnChange;
  192.   end;
  193.  
  194.   TPopupAlignment = (paLeft, paRight, paCenter);
  195.   TTrackButton = (tbRightButton, tbLeftButton);
  196.  
  197.   TPopupMenu = class(TMenu)
  198.   protected
  199.     function UseRightToLeftAlignment: Boolean;
  200.   public
  201.     constructor Create(AOwner: TComponent); override;
  202.     destructor Destroy; override;
  203.     procedure Popup(X, Y: Integer); virtual;
  204.     property PopupComponent: TComponent;
  205.     property TrackButton: TTrackButton default tbRightButton;
  206.   published
  207.     property Alignment: TPopupAlignment default paLeft;
  208.     property AutoPopup: Boolean default True;
  209.     property BiDiMode;
  210.     property HelpContext: THelpContext default 0;
  211.     property Images;
  212.     property OwnerDraw;
  213.     property ParentBiDiMode;
  214.     property OnChange;
  215.     property OnPopup: TNotifyEvent;
  216.   end;
  217.  
  218. function ShortCut(Key: Word; Shift: TShiftState): TShortCut;
  219. procedure ShortCutToKey(ShortCut: TShortCut; var Key: Word; var Shift: TShiftState);
  220. function ShortCutToText(ShortCut: TShortCut): string;
  221. function TextToShortCut(Text: string): TShortCut;
  222.  
  223. function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
  224. function NewPopupMenu(Owner: TComponent; const AName: string;
  225.   Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuitem): TPopupMenu;
  226. function NewSubMenu(const ACaption: string; hCtx: Word;
  227.   const AName: string; Items: array of TMenuItem; AEnabled: Boolean = True): TMenuItem;
  228. function NewItem(const ACaption: string; AShortCut: TShortCut;
  229.   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  230.   const AName: string): TMenuItem;
  231. function NewLine: TMenuItem;
  232.  
  233. { StripHotkey removes the & escape char that marks the hotkey character in the
  234.   string.  When the current locale is a Far East locale, this function also
  235.   looks for and removes parens around the hotkey, common in Far East locales. }
  236.  
  237. function StripHotKey(const Text: string): string;
  238.  
  239. implementation
  240.