home *** CD-ROM | disk | FTP | other *** search
-
- {*******************************************************}
- { }
- { Borland Delphi Visual Component Library }
- { }
- { Copyright (c) 1999 Inprise Corporation }
- { }
- {*******************************************************}
-
- unit ActnList;
-
- {$T-,H+,X+}
-
- interface
-
- uses Classes, Messages, ImgList;
-
- type
-
- { TContainedAction }
-
- TCustomActionList = class;
-
- TContainedAction = class(TBasicAction)
- protected
- procedure ReadState(Reader: TReader); override;
- procedure SetParentComponent(AParent: TComponent); override;
- public
- destructor Destroy; override;
- function Execute: Boolean; override;
- function GetParentComponent: TComponent; override;
- function HasParent: Boolean; override;
- function Update: Boolean; override;
- property ActionList: TCustomActionList;
- property Index: Integer;
- published
- property Category: string;
- end;
-
- TContainedActionClass = class of TContainedAction;
-
- { TCustomActionList }
-
- TActionEvent = procedure (Action: TBasicAction; var Handled: Boolean) of object;
-
- TCustomActionList = class(TComponent)
- protected
- procedure Change; virtual;
- procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- procedure SetChildOrder(Component: TComponent; Order: Integer); override;
- property OnChange: TNotifyEvent;
- property OnExecute: TActionEvent;
- property OnUpdate: TActionEvent;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function ExecuteAction(Action: TBasicAction): Boolean; override;
- function IsShortCut(var Message: TWMKey): Boolean;
- function UpdateAction(Action: TBasicAction): Boolean; override;
- property Actions[Index: Integer]: TContainedAction; default;
- property ActionCount: Integer;
- property Images: TCustomImageList;
- end;
-
- { TActionList }
-
- TActionList = class(TCustomActionList)
- published
- property Images;
- property OnChange;
- property OnExecute;
- property OnUpdate;
- end;
-
- { TControlAction }
-
- THintEvent = procedure (var HintStr: string; var CanShow: Boolean) of object;
-
- TCustomAction = class(TContainedAction)
- protected
- FImage: TObject;
- FMask: TObject;
- procedure AssignTo(Dest: TPersistent); override;
- procedure SetName(const Value: TComponentName); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function DoHint(var HintStr: string): Boolean; dynamic;
- function Execute: Boolean; override;
- property Caption: string;
- property Checked: Boolean default False;
- property DisableIfNoHandler: Boolean default True;
- property Enabled: Boolean default True;
- property HelpContext: THelpContext default 0;
- property Hint: string;
- property ImageIndex: TImageIndex default -1;
- property ShortCut: TShortCut default 0;
- property Visible: Boolean default True;
- property OnHint: THintEvent;
- end;
-
- TAction = class(TCustomAction)
- published
- property Caption;
- property Checked;
- property Enabled;
- property HelpContext;
- property Hint;
- property ImageIndex;
- property ShortCut;
- property Visible;
- property OnExecute;
- property OnHint;
- property OnUpdate;
- end;
-
- { TControlActionLink }
-
- TActionLink = class(TBasicActionLink)
- protected
- function IsCaptionLinked: Boolean; virtual;
- function IsCheckedLinked: Boolean; virtual;
- function IsEnabledLinked: Boolean; virtual;
- function IsHelpContextLinked: Boolean; virtual;
- function IsHintLinked: Boolean; virtual;
- function IsImageIndexLinked: Boolean; virtual;
- function IsShortCutLinked: Boolean; virtual;
- function IsVisibleLinked: Boolean; virtual;
- procedure SetCaption(const Value: string); virtual;
- procedure SetChecked(Value: Boolean); virtual;
- procedure SetEnabled(Value: Boolean); virtual;
- procedure SetHelpContext(Value: THelpContext); virtual;
- procedure SetHint(const Value: string); virtual;
- procedure SetImageIndex(Value: Integer); virtual;
- procedure SetShortCut(Value: TShortCut); virtual;
- procedure SetVisible(Value: Boolean); virtual;
- end;
-
- TActionLinkClass = class of TActionLink;
-
- { Action registration }
-
- TEnumActionProc = procedure (const Category: string; ActionClass: TBasicActionClass;
- Info: Pointer) of object;
-
- procedure RegisterActions(const CategoryName: string;
- const AClasses: array of TBasicActionClass; Resource: TComponentClass);
- procedure UnRegisterActions(const AClasses: array of TBasicActionClass);
- procedure EnumRegisteredActions(Proc: TEnumActionProc; Info: Pointer);
- function CreateAction(AOwner: TComponent; ActionClass: TBasicActionClass): TBasicAction;
-
- const
- RegisterActionsProc: procedure (const CategoryName: string;
- const AClasses: array of TBasicActionClass; Resource: TComponentClass) = nil;
- UnRegisterActionsProc: procedure (const AClasses: array of TBasicActionClass) = nil;
- EnumRegisteredActionsProc: procedure (Proc: TEnumActionProc; Info: Pointer) = nil;
- CreateActionProc: function (AOwner: TComponent; ActionClass: TBasicActionClass): TBasicAction = nil;
-
- implementation
-