dxpagecontrol.pas

PageControl 2.0 与1.0兼营版控件 ,TPageControl的扩展。增强了一些功能。

    procedure DoCustomDrawEx(ATabVisibleIndex: Integer; AFont: TFont);
    procedure DrawTabImageAndText(BackgroundColor: TColor); virtual;
    function GetClientRect: TRect; virtual; abstract;
    function GetDisplayRect: TRect; virtual; abstract;
    function GetGoDialogButtonBounds: TRect; virtual; abstract;
    function GetGoDialogPosition(GoDialogSize: TSize): TPoint; virtual; abstract;
    function GetHighlightedTextColor(ATabVisibleIndex: Integer): TColor;
    function GetMinTabSelectionDistance: TcxPCDistance; virtual; abstract;
    function GetMinTabNormalWidth: Integer; virtual; abstract;
    function GetTabBaseImageSize: TSize;
{$IFDEF VCL}
    procedure GetTabNativePartAndState(ATabVisibleIndex: Integer;
      var PartId, StateId: Integer); virtual; abstract;
{$ENDIF}
    function GetTabRotatedImageSize: TSize;
    function GetTabsNormalDistance: TcxPCDistance; virtual;
    function GetTabsPosition(NavigatorButtons: TcxPCNavigatorButtons): TcxPCTabsPosition; virtual; abstract;
    function GetTabVerticalTextBitmap(TabVisibleIndex: Integer): TBitmap;
    procedure InternalPolyLine(const APoints: array of TPoint; AColor: TColor);
    procedure InternalInvalidateRect(Rect: TRect);
    procedure InternalResetClipRegion;
    function InternalSetClipRect(ClipR: TRect; IntersectWithCurrentClipRegion: Boolean = True): Boolean;
    procedure InvalidateTabExtendedTabsRect(TabVisibleIndex: Integer);
    procedure InvalidateTabRect(TabVisibleIndex: Integer);
    function IsCustomDraw: Boolean;
    function IsNativePainting: Boolean; virtual;
    function IsOverButton(X, Y: Integer; var Button: TcxPCNavigatorButton): Boolean; virtual; abstract;
    function IsOverTab(TabVisibleIndex: Integer; X, Y: Integer): Boolean; virtual;
    procedure Paint; virtual;
    procedure PaintButtonsRegion; virtual; abstract;
    procedure PaintFrame; virtual; abstract;
    procedure PaintServiceRegions; virtual;
    procedure PaintTabsRegion; virtual; abstract;
    procedure PrepareOutTabImageAndTextData(ATabVisibleIndex: Integer;
      const AImageRect, ATextRect: TRect; const AVisibleText: TCaption);
    procedure RepaintButton(Button: TcxPCNavigatorButton; OldButtonState: TcxPCNavigatorButtonState); virtual;
    procedure RepaintButtonsRegion; virtual;
    procedure RepaintTab(TabVisibleIndex: Integer; TabPropertyChanged: TcxPCTabPropertyChanged); virtual;
    procedure RepaintTabsRegion; virtual;
    procedure RestoreClipRgn;
    procedure SaveClipRgn;

    property DisabledTextFaceColor: TColor read GetDisabledTextFaceColor;
    property DisabledTextShadowColor: TColor read GetDisabledTextShadowColor;
    property HighlightedTabBodyColor: TColor read GetHighlightedTabBodyColor;

    property ParentControl: TcxCustomTabControl read FParentControl;
    property ParentInfo: TcxPCPainterParentInfo read FParentInfo;
  public
    constructor Create(AParent: TcxCustomTabControl); virtual;
    destructor Destroy; override;

    class function GetStandardStyle: TcxPCStandardStyle; virtual;
    class function GetStyleID: TcxPCStyleID; virtual;
    class function GetStyleName: TCaption; virtual;
    class function HasLookAndFeel(ALookAndFeel: TcxLookAndFeel): Boolean; virtual;
    class function IsDefault(ALookAndFeel: TcxLookAndFeel): Boolean; virtual;
    class function IsMainTabBoundWithClient: Boolean; virtual;
    class function IsMultiSelectionAccepted: Boolean; virtual;
    class function IsStandardStyle: Boolean; virtual;
    class function IsTabPressable: Boolean; virtual;
//    property ID: TcxPCStyleID read GetStyleID;
//    property StandardStyle: TcxPCStandardStyle read GetStandardStyle;
  end;

  TcxPCPainterClass = class of TcxPCCustomPainter;

  TcxPCImageList = class
  private
    FBaseImageChangeLink: TChangeLink;
    FBaseImages: TImageList;
    FFreeNotificator: TcxFreeNotificator;
    FImageRotationAngle: TcxPCRotationAngle;
    FParent: TcxCustomTabControl;
    FRotatedImages: TList;
    FOnChange: TNotifyEvent;
    procedure BaseImageListChange(Sender: TObject);
    procedure Change;
    procedure ClearRotatedImages;
    procedure FreeNotification(AComponent: TComponent);
    class procedure OutError(SourceMethodName, Msg: TCaption);
    procedure RotateImage(Index: Integer; BackgroundColor: TColor; Enabled: Boolean);
    procedure RotateImages;
    procedure SetImageRotationAngle(const Value: TcxPCRotationAngle);
    procedure SetBaseImages(const Value: TImageList);
    function GetBaseImageSize: TSize;
    function GetRotatedImageSize: TSize;
  public
    constructor Create(AParent: TcxCustomTabControl);
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas; X, Y, Index: Integer; BackgroundColor: TColor;
      Enabled: Boolean = True);

    property BaseImages: TImageList read FBaseImages write SetBaseImages;
    property BaseImageSize: TSize read GetBaseImageSize;
    property ImageRotationAngle: TcxPCRotationAngle read FImageRotationAngle write SetImageRotationAngle default ra0;
    property RotatedImageSize: TSize read GetRotatedImageSize;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TcxCustomTabControl }

  TcxCustomTabControl = class(TcxControl)
  private
    FChangeEventLockCount: Integer;
    FClientRect: TRect;
    FExtendedBottomOrRightTabsRect: TRect;
    FExtendedTopOrLeftTabsRect: TRect;
    FFirstVisibleTab, FLastVisibleTab: Integer;
    FGoDialog: TcxPCGoDialog;
    FHideTabs: Boolean;
    FHotTrack: Boolean;
    FHotTrackNavigatorButton: TcxPCNavigatorButtonIndex;
    FHotTrackTabVisibleIndex: Integer;
    FImageBorder: Integer;
    FImages: TcxPCImageList;
    FIsClientRectLoaded: Boolean;
    FIsGoDialogShowing: Boolean;
    FIsHotAndPopup: Boolean;
    FIsLastVisibleTabFullyVisible: Boolean;
    FMainTabVisibleIndex: Integer;
    FMaxRotatedTabWidth: Integer;
    FMultiLine: Boolean;
    FMultiSelect: Boolean;
    FNavigatorButtons: TcxPCNavigatorButtons;
    FNavigatorButtonStates: array[TcxPCNavigatorButton] of TcxPCNavigatorButtonState;
    FNavigatorPosition: TcxPCNavigatorPosition;
    FOptions: TcxPCOptions;
    FOwnerDraw: Boolean;
    FPainter: TcxPCCustomPainter;
    FPressedNavigatorButton: TcxPCNavigatorButtonIndex;
    FPressedTabVisibleIndex: Integer;
    FRaggedRight: Boolean;
    FRotate: Boolean;
    FRowCount: Integer;
    FRowHeight: Integer;
    FScrollOpposite: Boolean;
    FShowFrame: Boolean;
    FStyle: TcxPCStyleID;
    FTabIndex: Integer;
    FTabPosition: TcxTabPosition;
    FTabs: TcxTabs;
    FTabSize: TSmallPoint;
    FTabsPosition: TcxPCTabsPosition;
    FTimer: TTimer;
    FTopOrLeftPartRowCount: Integer;
    FTracking: Integer;
    FUpdating: Boolean;
    FVisibleTabList: TcxVisibleTabList;
{$IFNDEF VCL}
    FHotTrackColor: TColor;
    FShift: TShiftState;
{$ENDIF}
    FOnChange: TNotifyEvent;
    FOnChanging: TcxTabChangingEvent;
    FOnDrawTab: TcxDrawTabEvent;
    FOnDrawTabEx: TcxDrawTabExEvent;
    FOnGetImageIndex: TcxGetTabImageEvent;

    procedure ArrowButtonClick(NavigatorButton: TcxPCNavigatorButton);
    procedure Calculate;
    procedure CalculateLongitudinalTabPositions(var TooSmallControlSize: Boolean);
    procedure CalculateRowHeight;
    procedure CalculateRowPositions;
    procedure CalculateTabNormalSize(Tab: TcxTab);
    procedure CalculateTabNormalSizes;
    function CanMouseWheel(const AMouseScreenPos: TPoint): Boolean;
    function CanPressArrowButton(NavigatorButton: TcxPCNavigatorButton): Boolean;
    procedure CorrectMaxRotatedTabWidth;
    procedure CorrectTabRect(TabVisibleIndex: Integer);
    procedure CreateGoDialog;
    procedure CreateTimer;
    function DialogCharHandler(Key: Integer): Boolean;
    function GetDisplayRect: TRect;
    function GetImages: TImageList;
    function GetLineWidth(LineIndexBoundsA: TcxPCLineIndexBoundsArray; LineNumber, cTabsDistance: Integer): Integer;
    function GetMainTabIndex: Integer;
    function GetMaxRotatedTabWidth: Integer;
    function GetNavigatorButton(NavigatorButtonIndex: TcxPCNavigatorButtonIndex): TcxPCNavigatorButton;
    function GetNavigatorButtons(OnlyObligatoryButtons: Boolean): TcxPCNavigatorButtons;
    function GetOptions: TcxPCOptions;
    function GetStyle: TcxPCStyleID;
    function GetTabExtendedTabsRect(TabVisibleIndex: Integer): TRect;
    function GetTabsTab(TabIndex: Integer): TcxTab;
    procedure InitializeLineBoundsA(var LineIndexBoundsA: TcxPCLineIndexBoundsArray; FirstIndex, LastIndex: Integer);
    function InternalGetClientRect: TRect;
    function InternalGetShiftState: TShiftState;
    procedure InternalInvalidateRect(Rect: TRect);
    function PassDesignMouseEvent(X, Y: Integer): Boolean;
    procedure PlaceVisibleTabsOnRows(TabsWidth, cTabsDistance: Integer);
    procedure RearrangeRows;
    procedure ReadClientRectBottom(Reader: TReader);
    procedure ReadClientRectLeft(Reader: TReader);
    procedure ReadClientRectRight(Reader: TReader);
    procedure ReadClientRectTop(Reader: TReader);
    procedure RepaintTab(TabVisibleIndex: Integer; TabPropertyChanged: TcxPCTabPropertyChanged);
    procedure SetHideTabs(const Value: Boolean);
    procedure SetHotTrack(const Value: Boolean);
    procedure SetImageBorder(const Value: Integer);
    procedure SetImages(const Value: TImageList);
    procedure SetMaxRotatedTabWidth(Value: Integer);
    procedure SetMultiLine(const Value: Boolean);
    procedure SetMultiSelect(const Value: Boolean);
    procedure SetNavigatorPosition(const Value: TcxPCNavigatorPosition);
    procedure SetOptions(Value: TcxPCOptions);
    procedure SetOwnerDraw(const Value: Boolean);
    procedure SetRaggedRight(const Value: Boolean);
    procedure SetRotate(const Value: Boolean);
    procedure SetScrollOpposite(const Value: Boolean);
    procedure SetShowFrame(const Value: Boolean);
    procedure SetStyle(const Value: TcxPCStyleID);
    procedure SetTabHeight(const Value: Smallint);
    procedure SetTabIndex(Value: Integer);
    procedure SetTabPosition(const Value: TcxTabPosition);
    procedure SetTabs(const Value: TcxTabs);
    procedure SetTabsTab(TabIndex: Integer; const Value: TcxTab);
    procedure SetTabWidth(const Value: Smallint);
    procedure SynchronizeHotTrackStates(Shift: TShiftState);
    procedure SynchronizeNavigatorButtons;
    procedure SynchronizeTabImagesRotationAngle;
    procedure TimerEventHandler(Sender: TObject);
    procedure UpdateArrowButtonsState;
    procedure WriteClientRectBottom(Writer: TWriter);
    procedure WriteClientRectLeft(Writer: TWriter);
    procedure WriteClientRectRight(Writer: TWriter);
    procedure WriteClientRectTop(Writer: TWriter);
{$IFDEF VCL}
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
{$ELSE}
    procedure SetHotTrackColor(const Value: TColor);
{$ENDIF}
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure DefineProperties(Filer: TFiler); override;
    function DoMouseWheelDown(Shift: TShiftState; {$IFNDEF VCL}const{$ENDIF} MousePos:
      TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; {$IFNDEF VCL}const{$ENDIF} MousePos:
      TPoint): Boolean; override;
    procedure FocusChanged; override;
    procedure FontChanged; override;
    function HasBackground: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); 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 Paint; override;
    procedure Resize; override;
    function CanChange(NewTabIndex: Integer): Boolean; dynamic;
    function CanShowTab(TabIndex: Integer): Boolean; virtual;
    procedure Change; dynamic;
    procedure CorrectFirstVisibleTab(TabVisibleIndex: Integer);
    procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual;
    function GetImageIndex(ATabIndex: Integer): Integer; virtual;
    procedure GoDialogSelectEventHandler(Sender: TObject); virtual;
    procedure HideGoDialog;
    procedure ImageListChange(Sender: TObject); virtual;
    function InternalKeyDown(var Key: Word; Shift: TShiftState): Boolean; virtual;
    function IsChangeEventLocked: Boolean;
    procedure LockChangeEvent(ALock: Boolean);
    class procedure OutError(SourceMethodName: TCaption; Msg: TCaption);
    procedure RequestLayout; dynamic;
    procedure SetDefaultStyle;
    procedure ShowGoDialog;
    function TabIndexTabMustBeVisible: Boolean; virtual;
    procedure UpdateTabImages;
{$IFDEF VCL}
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
{$ELSE}
    procedure CreateWidget; override;
    function DesignEventQuery(Sender: QObjectH; Event: QEventH): Boolean; override;
    procedure EnabledChanged; override;
    function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; override;
{$ENDIF}
    property DisplayRect: TRect read GetDisplayRect;
    property HideTabs: Boolean read FHideTabs write SetHideTabs default False;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property ImageBorder: Integer read FImageBorder write SetImageBorder default 0;
    property Images: TImageList read GetImages write SetImages;
    property MainTabIndex: Integer read GetMainTabIndex;
    property MaxRotatedTabWidth: Integer read GetMaxRotatedTabWidth
      write SetMaxRotatedTabWidth default 0;
    property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
    property NavigatorPosition: TcxPCNavigatorPosition read FNavigatorPosition
      write SetNavigatorPosition default npRightTop;
    property Options: TcxPCOptions read GetOptions write SetOptions default [];
    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
    property Painter: TcxPCCustomPainter read FPainter;
    property RaggedRight: Boolean read FRaggedRight write SetRaggedRight default False;
    property Rotate: Boolean read FRotate write SetRotate default False;
    property ScrollOpposite: Boolean read FScrollOpposite
      write SetScrollOpposite default False;
    property ShowFrame: Boolean read FShowFrame write SetShowFrame default False;
    property Style: TcxPCStyleID read GetStyle write SetStyle default cxPCDefaultStyle;
    property TabHeight: Smallint read FTabSize.Y write SetTabHeight default 0;
    property TabIndex: Integer read FTabIndex write SetTabIndex default -1;
    property TabPosition: TcxTabPosition read FTabPosition write SetTabPosition
      default tpTop;
    property Tabs: TcxTabs read FTabs write SetTabs;
    property TabsTabs[TabIndex: Integer]: TcxTab read GetTabsTab write SetTabsTab;
    property TabWidth: Smallint read FTabSize.X write SetTabWidth default 0;
{$IFNDEF VCL}
    property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor
      default clBlue;
{$ENDIF}
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TcxTabChangingEvent read FOnChanging write FOnChanging;
    property OnDrawTab: TcxDrawTabEvent read FOnDrawTab write FOnDrawTab;
    property OnDrawTabEx: TcxDrawTabExEvent read FOnDrawTabEx write FOnDrawTabEx;
    property OnGetImageIndex: TcxGetTabImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IndexOfTabAt(X, Y: Integer): Integer;
    procedure ScrollTabs(Delta: Integer);
    procedure SetStandardStyle(StandardStyle: TcxPCStandardStyle);
    procedure SetStyleByStyleName(StyleName: TCaption);
    property RowCount: Integer read FRowCount;
    property TopOrLeftPartRowCount: Integer read FTopOrLeftPartRowCount;
    property TabStop default True;
  end;

  { TdxPageControl }

  TdxPageControl = class(TcxCustomTabControl)
  private
    FActivePage: TdxTabSheet;
    FFocusable: Boolean;
    FPages: TList;
    FPageInserting: Boolean;
{$IFDEF VCL}
    FNewDockSheet: TdxTabSheet;
    FUndockingPage: TdxTabSheet;
{$ENDIF}
    FOnPageChanging: TcxPageChangingEvent;
    procedure ChangeActivePage(APage: TdxTabSheet);
    function GetActivePageIndex: Integer;
    function GetPage(Index: Integer): TdxTabSheet;
    function GetPageCount: Integer;
    function GetTabCount: Integer;
    procedure InsertPage(APage: TdxTabSheet);
    procedure RemovePage(APage: TdxTabSheet);