cxcontainer.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,761 行 · 第 1/5 页

      read GetStyle write SetStyle; default;
    property OnChanged: TNotifyEvent write SetOnChanged;
  end;

  TcxContainerStylesClass = class of TcxContainerStyles;

  { TcxStyleController }

  TcxStyleController = class(TComponent)
  private
    FIsDestruction: Boolean;
    FIsFontScaled: Boolean;
    FListeners: TList;
    FOnStyleChanged: TNotifyEvent;
    function GetFakeStyleController: TcxStyleController;
    function GetStyle: TcxContainerStyle;
    function GetInternalStyle(AState: TcxContainerStateItem): TcxContainerStyle;
    procedure SetFakeStyleController(Value: TcxStyleController);
    procedure SetInternalStyle(AState: TcxContainerStateItem; Value: TcxContainerStyle);
    procedure StyleChanged(Sender: TObject);
  protected
    FStyles: TcxContainerStyles;
    procedure Loaded; override;
    procedure AddListener(AListener: TcxContainerStyle); virtual;
    procedure Changed;
    procedure ChangeFontScale(M, D: Integer);
    function GetStyleClass: TcxContainerStyleClass; virtual;
    function GetStylesClass: TcxContainerStylesClass; virtual;
    function IsDestruction: Boolean;
    procedure RemoveListener(AListener: TcxContainerStyle); virtual;
    property Style: TcxContainerStyle read GetStyle;
    property Listeners: TList read FListeners;
    property OnStyleChanged: TNotifyEvent read FOnStyleChanged write FOnStyleChanged;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure RestoreStyles;
    property Styles[AState: TcxContainerStateItem]: TcxContainerStyle
      read GetInternalStyle write SetInternalStyle;
  published
    property FakeStyleController: TcxStyleController read GetFakeStyleController
      write SetFakeStyleController stored False;
  end;

  { IcxContainerInnerControl }

  IcxContainerInnerControl = interface
  ['{1B111318-D9C9-4C35-9EFF-5D95793C0106}']
    function GetControl: TWinControl;
    function GetControlContainer: TcxContainer;
    property Control: TWinControl read GetControl;
    property ControlContainer: TcxContainer read GetControlContainer;
  end;

  TcxScrollBarInfo = TScrollBarInfo;

  { TcxContainer }

  TcxContainerActiveStyleData = record
    ContainerState: TcxContainerState;
    ActiveStyle: TcxContainerStyle;
  end;

  TcxContainerInnerControlBounds = record
    IsEmpty: Boolean;
    Rect: TRect;
  end;

  TcxContainerSizeGripData = record
    Bounds: TRect;
    Visible: Boolean;
  end;

  TcxContainer = class(TcxControl, IUnknown,
    IcxCompoundControl, IcxMouseTrackingCaller)
  private
    FActiveStyleData: TcxContainerActiveStyleData;
    FInnerControl: TWinControl;
    FInnerControlBounds: TcxContainerInnerControlBounds;
    FInnerControlMouseDown: Boolean;
    FInnerControlBufferedPaint: Boolean;
    FSaveInnerControlWndProc: TWndMethod;
    FIsDestroying: Boolean;
    FIsRefreshLocked: Boolean;
    FIsViewInfoCalculated: Boolean;
    FLockAlignControlsCount: Integer;
    FOnGlass: Boolean;
    FRepaintOnGlass: Boolean;
    FPopupMenuLockCount: Integer;
    FRefreshingContainer: Boolean;
    FScrollBarsCalculating: Boolean;
    FSizeGripData: TcxContainerSizeGripData;
    function GetActiveControl: TWinControl;
    function GetFakeStyleController: TcxStyleController;
    function GetInternalStyle(AState: TcxContainerStateItem): TcxContainerStyle;
    function GetIsDestroying: Boolean;
    function GetStyle: TcxContainerStyle;
    function GetStyleDisabled: TcxContainerStyle;
    function GetStyleFocused: TcxContainerStyle;
    function GetStyleHot: TcxContainerStyle;
    procedure SetFakeStyleController(Value: TcxStyleController);
    procedure SetInnerControl(Value: TWinControl);
    procedure SetStyle(Value: TcxContainerStyle);
    procedure SetStyleDisabled(Value: TcxContainerStyle);
    procedure SetStyleFocused(Value: TcxContainerStyle);
    procedure SetStyleHot(Value: TcxContainerStyle);
    procedure SetInternalStyle(AState: TcxContainerStateItem;
      Value: TcxContainerStyle);
    function GetDragKind: TDragKind;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged);
      message WM_WINDOWPOSCHANGED;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
      message WM_WINDOWPOSCHANGING;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure CMShortRefreshContainer(var Message: TMessage); message CM_SHORTREFRESHCONTAINER;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMUpdateScrollBars(var Message: TMessage); message CM_UPDATESCROLLBARS;
  protected
    FInternalSetting: Boolean;
    FIsCreating: Boolean;
    FStyles: TcxContainerStyles;
    FViewInfo: TcxContainerViewInfo;

    // IcxMouseTrackingCaller
    procedure IcxMouseTrackingCaller.MouseLeave = MouseTrackingCallerMouseLeave;
    procedure MouseTrackingCallerMouseLeave;

    // IcxLookAndFeelContainer
    function GetLookAndFeelValue: TcxLookAndFeel; override;

    procedure AdjustClientRect(var Rect: TRect); override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    function AllowAutoDragAndDropAtDesignTime(X, Y: Integer;
      Shift: TShiftState): Boolean; override;
    function CanFocusOnClick: Boolean; override;
    procedure ChangeScale(M, D: Integer); override;
    procedure ColorChanged; override;
    procedure CursorChanged; override;
    procedure DoContextPopup(MousePos: TPoint;
      var Handled: Boolean); override;
    procedure DragCanceled; override;
    procedure DrawBordersBackgroundByPainter(ACanvas: TcxCanvas;
      APainter: TcxCustomLookAndFeelPainterClass);
    procedure FocusChanged; override;
    function FocusWhenChildIsClicked(AChild: TControl): Boolean; override;
    function GetClientBounds: TRect; override;
    function IsContainerFocused: Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    function MayFocus: Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function NeedsScrollBars: Boolean; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure Resize; override;
    procedure SetDragMode(Value: TDragMode); override;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    procedure AdjustInnerControl; virtual;
    procedure CalculateViewInfo(const P: TPoint; AMouseTracking: Boolean); virtual;
    function CanContainerHandleTabs: Boolean; virtual;
    function CanHaveTransparentBorder: Boolean; virtual;
    function CanShowPopupMenu(const P: TPoint): Boolean; virtual;
    procedure CheckIsViewInfoCalculated;
    procedure ContainerStyleChanged(Sender: TObject); virtual;
    procedure DataChange; virtual;
    procedure DataSetChange; virtual;
    function DefaultParentColor: Boolean; virtual;
    procedure EnabledChanged; dynamic;
    procedure EndMouseTracking; virtual;
    function GetActiveStyle: TcxContainerStyle; virtual;
    function GetBorderExtent: TRect; virtual;
    function GetInnerControlBounds(const AInnerControlsRegion: TRect;
      AInnerControl: TControl): TcxContainerInnerControlBounds; virtual;
    function GetShadowBounds: TRect; virtual;
    function GetStyleClass: TcxContainerStyleClass; virtual;
    function GetStylesClass: TcxContainerStylesClass; virtual;
    function GetViewInfoClass: TcxContainerViewInfoClass; virtual;
    function HasShadow: Boolean; virtual;
    procedure InnerControlWndProc(var Message: TMessage); virtual;
    function InternalGetActiveStyle: TcxContainerStyle; virtual;
    function InternalGetNotPublishedStyleValues: TcxContainerStyleValues; virtual;
    function IsAlignControlsLocked: Boolean;
    function IsInnerControlBoundsChanged(AControl: TWinControl;
      const ABounds: TcxContainerInnerControlBounds): Boolean;
    function IsContainerClass: Boolean; virtual;
    function IsPopupMenuLocked: Boolean;
    function IsReadOnly: Boolean; virtual;
    function IsTransparentBackground: Boolean; virtual;
    function RefreshContainer(const P: TPoint; Button: TcxMouseButton; Shift: TShiftState;
      AIsMouseEvent: Boolean): Boolean; virtual;
    procedure SaveInnerControlBounds(AControl: TWinControl;
      const ABounds: TcxContainerInnerControlBounds);
    procedure SetShadowRegion; virtual;
    procedure SetSize; virtual;
    procedure SetVisibleBoundsClipRect; virtual;
    procedure UpdateData; virtual;
    procedure AdjustScrollBarPosition(AScrollBar: TcxScrollBar); virtual;
    function GetBackgroundThemedObjectType: TdxThemedObjectType; virtual;
    function GetBackgroundNativePart: Integer; virtual;
    function GetBackgroundNativeState: Integer; virtual;
    function GetScrollBarBounds(const AScrollBarRect: TRect): TRect; virtual;
    function GetScrollBarEnabled(AScrollBar: TcxScrollBar;
      const AScrollBarinfo: TcxScrollBarInfo): Boolean; virtual;
    function GetScrollBarInfo(var AScrollBarInfo: TcxScrollBarInfo;
      const AKind: TScrollBarKind): Boolean; virtual;
    function IsAdjustingScrollBarPositionNeeded(
      const AScrollBarInfo: TcxScrollBarInfo): Boolean; virtual;
    function IsNativeStyle: Boolean; virtual;
    procedure SafeSelectionFocusInnerControl; virtual;
    procedure SetDragKind(Value: TDragKind); virtual;
    procedure SetScrollBarVisible(AScrollBar: TcxScrollBar;
      AVisible: Boolean); virtual;
    property ActiveStyle: TcxContainerStyle read GetActiveStyle;
    property DragKind: TDragKind read GetDragKind write SetDragKind default dkDrag;
    property IsViewInfoCalculated: Boolean read FIsViewInfoCalculated
      write FIsViewInfoCalculated;
    property ScrollBarsCalculating: Boolean read FScrollBarsCalculating;
    property Style: TcxContainerStyle read GetStyle write SetStyle;
    property StyleDisabled: TcxContainerStyle read GetStyleDisabled
      write SetStyleDisabled;
    property StyleFocused: TcxContainerStyle read GetStyleFocused
      write SetStyleFocused;
    property StyleHot: TcxContainerStyle read GetStyleHot write SetStyleHot;
    property ViewInfo: TcxContainerViewInfo read FViewInfo;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Focused: Boolean; override;
    function GetDragImages: TDragImageList; override;
    procedure GetTabOrderList(List: TList); override;
    procedure SetFocus; override;
    procedure ClearSavedChildControlRegions; virtual;
    function GetVisibleBounds: TRect; virtual;
    function HasPopupWindow: Boolean; virtual;
    function InnerControlDefaultHandler(var Message: TMessage): Boolean; virtual;
    function InnerControlMenuHandler(var Message: TMessage): Boolean; virtual;
    procedure Invalidate; override;
    function IsInplace: Boolean; virtual;
    function IsStylePropertyPublished(const APropertyName: string;
      AExtendedStyle: Boolean): Boolean;
    procedure LockAlignControls(ALock: Boolean);
    procedure LockPopupMenu(ALock: Boolean);
    procedure RestoreStyles;
    procedure SetScrollBarsParameters(AIsScrolling: Boolean = False); virtual;
    function ShortRefreshContainer(AIsMouseEvent: Boolean): Boolean;
    procedure Update; override;
    procedure UpdateScrollBarsParameters;
    property InnerControl: TWinControl read FInnerControl write SetInnerControl;
    property InnerControlMouseDown: Boolean read FInnerControlMouseDown
      write FInnerControlMouseDown;
    property IsDestroying: Boolean read GetIsDestroying;
    property OnGlass: Boolean read FOnGlass write FOnGlass;
    property ParentColor;
    property ParentFont;
    property Styles[AState: TcxContainerStateItem]: TcxContainerStyle
      read GetInternalStyle write SetInternalStyle;
    property VisibleBounds: TRect read GetVisibleBounds;
  published
    property FakeStyleController: TcxStyleController read GetFakeStyleController
      write SetFakeStyleController stored False;
    property TabStop default True;
  end;

  { TcxCustomPopupWindow }

  TcxCustomPopupWindow = class(TcxPopupWindow)
  private
    FCaptureFocus: Boolean;
    FDeactivateLockCount: Integer;
    FDeactivation: Boolean;
    FFocusedControl: TWinControl;
    FIsTopMost: Boolean;
    FJustClosed: Boolean;
    FModalMode: Boolean;
    FTerminateOnDestroy: Boolean;
    FOwnerControl: TWinControl;
    FOnClosed: TNotifyEvent;
    FOnClosing: TNotifyEvent;
    FOnShowed: TNotifyEvent;
    FOnShowing: TNotifyEvent;
    function GetJustClosed: Boolean;
    procedure SetCaptureFocus(Value: Boolean);
    procedure SetIsTopMost(Value: Boolean);
    procedure WMActivateApp(var Message: TWMActivateApp); message WM_ACTIVATEAPP;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMClosePopupWindow(var Message: TMessage); message CM_CLOSEPOPUPWINDOW;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMShowPopupWindow(var Message: TMessage); message CM_SHOWPOPUPWINDOW;
  protected
    FStyle: TcxContainerStyle;
    FViewInfo: TcxContainerViewInfo;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure Deactivate; override;
    function GetOwnerScreenBounds: TRect; override;
    procedure InitPopup; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Paint; override;
    procedure VisibleChanged; override;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function AcceptsAnySize: Boolean; virtual;
    procedure DoClosed; virtual;
    procedure DoClosing; virtual;
    procedure DoShowed; virtual;
    procedure DoShowing; virtual;
    function GetFirstFocusControl(AControl: TWinControl): TWinControl;
    function HasBackground: Boolean; virtual;
    function IsDeactivateLocked: Boolean;
    function IsOwnerControlVisible: Boolean;
    function IsSysKeyAccepted(Key: Word): Boolean; virtual;
    procedure ModalCloseUp; virtual;
    procedure MouseEnter(AControl: TControl); dynamic;
    procedure MouseLeave(AControl: TControl); dynamic;
    function NeedIgnoreMouseMessageAfterCloseUp(AWnd: THandle; AMsg: Cardinal;
      AShift: TShiftState; const APos: TPoint): Boolean; virtual;
    procedure PopupWindowStyleChanged(Sender: TObject); virtual;
    procedure RecreateWindow;
    property Style: TcxContainerStyle read FStyle;
    property ViewInfo: TcxContainerViewInfo read FViewInfo;
  public
    constructor Create(AOwnerControl: TWinControl); reintroduce; virtual;
    destructor Destroy; override;
    function Focused: Boolean; override;
{$IFDEF DELPHI5}
    function CanFocus: Boolean; override;
{$ENDIF}
    procedure ClosePopup;
    procedure CloseUp; override;
    procedure CorrectBoundsWithDesktopWorkArea(var APosition: TPoint); virtual;
    function GetStyleClass: TcxContainerStyleClass; virtual;
    function GetViewInfoClass: TcxContainerViewInfoClass; virtual;
    function HasCapture: Boolean;
    function IsShortCut(var Message: TWMKey): Boolean; override;
    function IsVisible: Boolean;