se_controls.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 1,763 行 · 第 1/5 页

    procedure SetHint (const Value: String); override;
    procedure SetImageIndex (Value: Integer); override;
    procedure SetShortCut (Value: TShortCut); override;
    procedure SetVisible (Value: Boolean); override;
    procedure SetOnExecute (Value: TNotifyEvent); override;
  end;

  TSeCustomItemActionLinkClass = class of TSeCustomItemActionLink;

  TSeItemView = class;

  TSeMDIItemKind = (mikNone, mikClose, mikRestore, mikMinimize, mikSysMenu);

{ TSeCustomItem }

  TSeCustomItem = class(TComponent)
  private
    FCaption: String;
    FChecked: Boolean;
    FEnabled: Boolean;
    FHelpContext: THelpContext;
    FHint: String;
    FImageIndex: Integer;
    FImages: TCustomImageList;
    FShortCut: TShortCut;
    FVisible: Boolean;
    FOnClick: TNotifyEvent;
    FOnBeforeDropDown: TNotifyEvent;

    FActionLink: TSeCustomItemActionLink;
    FParent: TSeCustomItem;
    FParentComponent: TComponent;
    FItems: TList;
    FOnInternalChange: TNotifyEvent;
    FMDIItemKind: TSeMDIItemKind;
    FActiveMDIForm: TComponent;
    FFirst: boolean;
    FOnlyFirst: boolean;
    FOwnerForm: TWinControl;
    FBiDiMode: TBiDiMode;
    FIsToolbar: boolean;
    FTray: boolean;
    FScrolled: boolean;
    FTopItem: integer;
    FScrollCount: integer;
    FDrawingDisabled: boolean;
    FItemRect: TRect;
    FPopupMenuOptions: TSePopupMenuOptions;
    function GetAction: TBasicAction;
    procedure SetAction (Value: TBasicAction);
    procedure SetCaption (Value: String);
    procedure SetChecked (Value: Boolean);
    procedure SetEnabled (Value: Boolean);
    procedure SetImageIndex (Value: Integer);
    procedure SetImages (Value: TCustomImageList);
    procedure SetVisible (Value: Boolean);
    function GetItemCount: integer;
    function GetItem(Index: Integer): TSeCustomItem;
    function GetOwnerCustomForm: TComponent;

    procedure DoActionChange(Sender: TObject);
    function IsCaptionStored: Boolean;
    function IsCheckedStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHelpContextStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    function IsOnClickStored: Boolean;
    function IsShortCutStored: Boolean;
    function IsVisibleStored: Boolean;

    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean);
    function GetImgList: TCustomImageList;
    procedure SetActiveMDIForm(const Value: TComponent);
    procedure SetFirst(const Value: boolean);
    procedure SetOnlyFirst(const Value: boolean);
    procedure SetOwnerForm(const Value: TWinControl);
    function UseRightToLeftAlignment: Boolean;
    function UseRightToLeftReading: Boolean;
    procedure SetBiDiMode(const Value: TBiDiMode);
    procedure SetIsToolbar(const Value: boolean);
    procedure SetTray(const Value: boolean);
    procedure SetScrollCount(const Value: integer);
    procedure SetScrolled(const Value: boolean);
    procedure SetTopItem(const Value: integer);
    procedure SetDrawingDisabled(const Value: boolean);
    procedure SetPopupMenuOptions(const Value: TSePopupMenuOptions);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetParentComponent(Value: TComponent); override;

    function DrawTextBiDiModeFlags(Flags: Integer): Longint;
    function DrawTextBiDiModeFlagsReadingOnly: Longint;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;

    procedure DoClick; dynamic;

    function CreatePopupWindowClass: TClass; virtual;
    property ActionLink: TSeCustomItemActionLink read FActionLink write FActionLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    function HasParent: Boolean; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetParentComponent: TComponent; override;

    function FindItem(Value: Integer; Kind: TFindItemKind): TSeCustomItem;
    function FindItemByChar(C: Char): TSeCustomItem;
    function IsShortCut(var Msg: TWMKey): boolean;

    procedure Click; dynamic;
    procedure Change; virtual;

    procedure Popup(View: TSeItemView; X, Y: integer; Rect: TRect);

    function GetGlyphSize: integer;
    procedure CalcSize(Canvas: TCanvas; View: TSeItemView; var AWidth, AHeight: integer); virtual;
    procedure DrawItem(Canvas: TCanvas; View: TSeItemView; Rect: TRect; Active, Hover: boolean); virtual;
    procedure DrawScrollButton(Canvas: TCanvas; View: TSeItemView; Rect: TRect; Button: TSeMenuScrollButton; Active: boolean); virtual;

    procedure Clear;
    procedure Add(AItem: TSeCustomItem);
    function ContainsItem(AItem: TSeCustomItem): Boolean;
    procedure Delete(Index: Integer);
    function IndexOf(AItem: TComponent): Integer;
    procedure Insert(NewIndex: Integer; AItem: TSeCustomItem);
    procedure Remove(Item: TSeCustomItem);
    procedure InitiateAction; virtual;
    { MenuBar Animation }
    property First: boolean read FFirst write SetFirst;
    property OnlyFirst: boolean read FOnlyFirst write SetOnlyFirst;
    { PopupMenuOptions options }
    property PopupMenuOptions: TSePopupMenuOptions read FPopupMenuOptions write SetPopupMenuOptions;
    { Intenal properies }
    property ActiveMDIForm: TComponent read FActiveMDIForm write SetActiveMDIForm;
    property DrawingDisabled: boolean read FDrawingDisabled write SetDrawingDisabled;
    property ItemRect: TRect read FItemRect write FItemRect;
    property IsToolbar: boolean read FIsToolbar write SetIsToolbar;
    property MDIItemKind: TSeMDIItemKind read FMDIItemKind write FMDIItemKind;
    property OwnerForm: TWinControl read FOwnerForm write SetOwnerForm;
    property Tray: boolean read FTray write SetTray;
    { Properties }
    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode;
    property ImgList: TCustomImageList read GetImgList;
    property Items[Index: Integer]: TSeCustomItem read GetItem; default;
    { Scroll}
    property TopItem: integer read FTopItem write SetTopItem;

    property OnInternalChange: TNotifyEvent read FOnInternalChange write FOnInternalChange stored false;
  published
    { Properties }
    property Action: TBasicAction read GetAction write SetAction;
    property Count: Integer read GetItemCount;
    property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0;
    property Hint: String read FHint write FHint stored IsHintStored;
    property Parent: TSeCustomItem read FParent;
    property ParentComponent: TComponent read FParentComponent write FParentComponent;
    property Checked: Boolean read FChecked write SetChecked stored IsCheckedStored default False;
    property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
    property Caption: String read FCaption write SetCaption stored IsCaptionStored;
    property ImageIndex: Integer read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property Scrolled: boolean read FScrolled write SetScrolled;
    property ScrollCount: integer read FScrollCount write SetScrollCount;
    property ShortCut: TShortCut read FShortCut write FShortCut stored IsShortCutStored default 0;
    property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
    property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
    property OnBeforeDropDown: TNotifyEvent read FOnBeforeDropDown write FOnBeforeDropDown;
  end;

  TSeCustomItemClass = class of TSeCustomItem;

{ TSeItemView class }

  TSeViewOrientation = (voVertical, voHorizontal);

  TSeItemView = class(TComponent)
  private
    FItems: TSeCustomItem;
    FIsMenuBar: boolean;
    FOrientation: TSeViewOrientation;
    FParentComponent: TComponent;
    FWindow: TWinControl;
    FSelItem: TSeCustomItem;
    FDropDown: boolean;
    FLoop: boolean;

    FParentView: TSeItemView;
    FChildView: TSeItemView;

    FCanvas: TCanvas;
    FLeft: integer;
    FTop: integer;
    FWidth, FHeight: integer;
    FScrollTimer: TTimer;
    FPopupTimer: TTimer;
    FActiveScrollButton: TSeMenuScrollButton;
    procedure DoScrollTimer(Sender: TObject);
  protected
    procedure SetSize(ASize: TPoint); virtual;
    procedure SetPosition(APosition: TPoint); virtual;
    function CheckDropDown: Boolean;

    procedure InvalidateView; virtual;
    procedure InvalidateItem(AItem: TSeCustomItem); virtual;
    procedure InvalidateScrollButton(Button: TSeMenuScrollButton); virtual;

    function Popup: Boolean;
    procedure SelectNext;
    procedure SelectPrev;

    procedure StartScroll;
    procedure StopScroll;

    property Loop: boolean read FLoop;
    property SelItem: TSeCustomItem read FSelItem;
    property ActiveScrollButton: TSeMenuScrollButton read FActiveScrollButton;
  public
    constructor CreateView(AOwner: TComponent; AIsMenuBar: boolean;
      AOrientation: TSeViewOrientation);
    destructor Destroy; override;

    procedure InitiateAction; virtual;

    procedure CalcSize;
    function MessageLoop: Boolean;

    procedure Paint(Canvas: TCanvas); virtual;
    { Mouse routines }
    function GetItemRect(Item: TSeCustomItem): TRect;
    function GetScrollButtonRect(Button: TSeMenuScrollButton): TRect;
    procedure UpdateHover(P: TPoint);
    { Properties }
    property Canvas: TCanvas read FCanvas write FCanvas;
    property Items: TSeCustomItem read FItems write FItems;
    property IsMenuBar: boolean read FIsMenuBar;
    property ParentComponent: TComponent read FParentComponent write FParentComponent;
    property ParentView: TSeItemView read FParentView write FParentView;
    property Window: TWinControl read FWindow write FWindow;
    property Left: integer read FLeft write FLeft;
    property Top: integer read FTop write FTop;
  end;

  EKsItemError = class(Exception);

{ TSeItemContainer abstract items container }

  TSeInsertItemProc = procedure(AParent: TComponent; AItem: TSeCustomItem) of object;
  TSeGetItemClassProc = procedure(var AItemClass: TSeCustomItemClass) of object;

procedure RegisterContainerClass(const AClass: TClass; AInsertItemProc: TSeInsertItemProc;
  AGetItemClassProc: TSeGetItemClassProc);
procedure UnregisterContainerClass(const AClass: TClass);
function GetItemClass(const AClass: TClass): TSeCustomItemClass;

var
  MenuFont: TFont;


type

{ TSeMenuBarView }

  TSeCustomMenuBar = class;

  TSeMenuBarView = class(TSeItemView)
  private
    FMenuBar: TSeCustomMenuBar;
  protected
    procedure SetSize(ASize: TPoint); override;
    procedure SetPosition(APosition: TPoint); override;
    procedure InvalidateView; override;
    procedure InvalidateItem(AItem: TSeCustomItem); override;
  public
    constructor CreateView(AOwner: TComponent; ACanvas: TCanvas);
  end;

{ TSeCustomMenuBar class }

{ TSeCustomMenuBar is a menu bar and its accompanying drop-down menus for a form. }
  TSeCustomMenuBar = class(TSeCustomControl)
  private
    FDisableUpdate: boolean;
    FItems: TSeCustomItem;
    FView: TSeMenuBarView;
    FPopupMenuOptions: TSePopupMenuOptions;
    FAutoSize: boolean;
    { MDI Child }
    FActiveMDIForm: TComponent;
    { Updating }
    FUpdating: integer;
    FShowBevel: boolean;
    procedure DoMDIItemClick(Sender: TObject);
    procedure DoInternalChange(Sender: TObject);
    { messages }
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    { properties }
    function GetImages: TCustomImageList;
    procedure SetImages(Value: TCustomImageList);
    procedure SetAutoSize(const Value: boolean);
    procedure SetPopupMenuOptions(const Value: TSePopupMenuOptions);
    procedure SetShowBevel(const Value: boolean);
  protected
    FCalcSize: boolean;
    FSysMenu: TSeCustomItem;
    FMin: TSeCustomItem;
    FRestore: TSeCustomItem;
    FClose: TSeCustomItem;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure SetParent(AParent: TWinControl); override;
    { for next }
    function GetViewRect: TRect; virtual;
    { overrides }
    procedure PaintBuffer; override;
    { need for }
    class procedure InsertItemProc(AParent: TComponent; AItem: TSeCustomItem); virtual;
    class procedure GetItemClassProc(var AItemClass: TSeCustomItemClass); virtual;

    procedure ItemsChanged; virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    property View: TSeMenuBarView read FView;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure InitiateAction; override;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure EnterLoop;
    function IsShortCut(var Msg: TWMKey): boolean;
    { MDI }
    procedure ShowMDIItems(AMDIForm: TComponent);
    procedure HideMDIItems;
    { Updating }
    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property Align;
    property Anchors;
    property AutoSize: boolean read FAutoSize write SetAutoSize default true;
    property Images: TCustomImageList read GetImages write SetImages;
    property Items: TSeCustomItem read FItems;
    property PopupMenuOptions: TSePopupMenuOptions read FPopupMenuOptions write SetPopupMenuOptions;
    property ShowBevel: boolean read FShowBevel write SetShowBevel default false;
  end;