dxpagecontrol.pas

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

    procedure SetActivePage(APage: TdxTabSheet);
    procedure SetActivePageIndex(Value: Integer);
    procedure SetFocusable(Value: Boolean);
{$IFDEF VCL}
    function GetDockClientFromPoint(P: TPoint): TControl;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
    procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION;
    procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT;
{$ELSE}
    procedure SetFocusPolicy;
{$ENDIF}
  protected
    function CanChange(NewTabIndex: Integer): Boolean; override;
    function CanShowTab(TabIndex: Integer): Boolean; override;
    procedure Change; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure ImageListChange(Sender: TObject); override;
    procedure Loaded; override;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure ShowControl(AControl: TControl); override;
    function TabIndexTabMustBeVisible: Boolean; override;
{$IFDEF VCL}
    function CanFocusOnClick: Boolean; override;
    procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
    procedure DockOver(Source: TDragDockObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean); override;
    procedure DoRemoveDockClient(Client: TControl); override;
    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
      MousePos: TPoint; var CanDock: Boolean); override;
{$ELSE}
    procedure InitWidget; override;
{$ENDIF}
    function CanChangeActivePage(NewPage: TdxTabSheet): Boolean; dynamic;
    procedure PageChange; dynamic;
    procedure PageChanging(NewPage: TdxTabSheet; var AllowChange: Boolean);
    procedure UpdateActivePage; virtual;
    procedure UpdateTab(APage: TdxTabSheet);
    procedure UpdateTabs;
{$IFDEF VCL}
    function GetPageFromDockClient(Client: TControl): TdxTabSheet;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
{$IFDEF VCL}
    procedure GetTabOrderList(List: TList); override;
{$ENDIF}
{$IFDEF DELPHI5}
    function CanFocus: Boolean; override;
{$ENDIF}
    function FindNextPage(CurrentPage: TdxTabSheet;
      GoForward, CheckTabVisible: Boolean): TdxTabSheet;
    procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean = True);
    property ActivePageIndex: Integer read GetActivePageIndex
      write SetActivePageIndex;
    property PageCount: Integer read GetPageCount;
    property Pages[Index: Integer]: TdxTabSheet read GetPage;
    property Painter;
    property TabCount: Integer read GetTabCount;
  published
    property ActivePage: TdxTabSheet read FActivePage write SetActivePage;
    property Align;
    property Anchors;
    property Constraints;
    property DragMode;
    property Enabled;
    property Focusable: Boolean read FFocusable write SetFocusable default True;
    property Font;
    property HideTabs;
    property HotTrack;
    property ImageBorder;
    property Images;
    property LookAndFeel;
    property MaxRotatedTabWidth;
    property MultiLine;
    property NavigatorPosition;
    property Options;
    property OwnerDraw;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property Rotate;
    property ScrollOpposite;
    property ShowFrame;
    property ShowHint;
    property Style;
    property TabHeight;
    property TabOrder;
    property TabPosition;
    property TabWidth;
    property Visible;
{$IFDEF VCL}
    property BiDiMode;
    property DockSite;
    property DragCursor;
    property DragKind;
    property ParentBiDiMode;
{$ELSE}
    property HotTrackColor;
{$ENDIF}
    property OnChange;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnDrawTabEx;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPageChanging: TcxPageChangingEvent read FOnPageChanging write FOnPageChanging;
    property OnResize;
    property OnStartDrag;
{$IFDEF VCL}
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
{$ENDIF}
  end;

  TdxTabSheet = class(TCustomControl)
  private
{$IFNDEF VCL}
    FBorderWidth: TBorderWidth;
{$ENDIF}
    FHighlighted: Boolean;
    FImageIndex: {$IFDEF DELPHI5}TImageIndex{$ELSE}Integer{$ENDIF};
    FPageControl: TdxPageControl;
    FTab: TcxTab;
    FTabShowing: Boolean;
    FTabVisible: Boolean;
    FOnHide: TNotifyEvent;
    FOnShow: TNotifyEvent;
    function GetPageIndex: Integer;
    function GetTabIndex: Integer;
{$IFNDEF VCL}
    procedure SetBorderWidth(const Value : TBorderWidth);
{$ENDIF}
    procedure SetHighlighted(const Value: Boolean);
    procedure SetImageIndex(const Value: {$IFDEF DELPHI5}TImageIndex{$ELSE}Integer{$ENDIF});
    procedure SetPageControl(const Value: TdxPageControl);
    procedure SetPageIndex(const Value: Integer);
    procedure SetTabVisible(const Value: Boolean);
{$IFDEF VCL}
    procedure DrawNativeBackground(DC: HDC);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
{$ENDIF}
  protected
    procedure ReadState(Reader: TReader); override;
{$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
{$ELSE}
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure InitWidget; override;
{$ENDIF}
    procedure DoHide; dynamic;
    procedure DoShow; dynamic;
    procedure EnabledChanged; {$IFDEF VCL}dynamic{$ELSE}override{$ENDIF};
    procedure PagePropertyChanged;
    procedure ShowingChanged; {$IFDEF VCL}dynamic{$ELSE}override{$ENDIF};
    procedure TextChanged; {$IFDEF VCL}dynamic{$ELSE}override{$ENDIF};
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property PageControl: TdxPageControl read FPageControl write SetPageControl;
    property TabIndex: Integer read GetTabIndex;
    property TabShowing: Boolean read FTabShowing;
  published
{$IFDEF VCL}
    property BorderWidth;
{$ELSE}
    property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
{$ENDIF}
    property Caption;
    property Color;
    property Constraints;
    property DragMode;
    property Enabled;
    property Font;
    property Height stored False;
    property Highlighted: Boolean read FHighlighted write SetHighlighted default False;
    property ImageIndex: {$IFDEF DELPHI5}TImageIndex{$ELSE}Integer{$ENDIF}
      read FImageIndex write SetImageIndex default -1;
    property Left stored False;
    property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabVisible: Boolean read FTabVisible write SetTabVisible default True;
    property Top stored False;
    property Visible stored False;
    property Width stored False;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnStartDrag;
  end;

  { TcxTabControl }

  TcxTabControl = class(TcxCustomTabControl)
  protected
    procedure Change; override;
  public
    property DisplayRect;
    property Painter;
  published
    property Align;
    property Anchors;
    property Constraints;
    property DragMode;
    property Enabled;
    property Font;
    property HideTabs;
    property HotTrack;
    property ImageBorder;
    property Images;
    property LookAndFeel;
    property MaxRotatedTabWidth;
    property MultiLine;
    property MultiSelect;
    property NavigatorPosition;
    property Options;
    property OwnerDraw;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property Rotate;
    property ScrollOpposite;
    property ShowFrame;
    property ShowHint;
    property Style;
    property TabHeight;
    property TabIndex;
    property TabOrder;
    property TabPosition;
    property Tabs;
    property TabStop;
    property TabWidth;
    property Visible;
{$IFNDEF VCL}
    property HotTrackColor;
{$ENDIF}
    property OnChange;
    property OnChanging;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnDrawTabEx;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
{$IFDEF VCL}
    property BiDiMode;
    property DockSite;
    property DragCursor;
    property DragKind;
    property ParentBiDiMode;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
{$ENDIF}
  end;

procedure CorrectRect(var Rect: TRect; RectCorrection: TcxPCRectCorrection);
function DistanceGetter(const Distance: TcxPCDistance; const LongitudinalDistance: Boolean): Integer;
function GetButtonCount(NavigatorButtons: TcxPCNavigatorButtons): Integer;
function GetTextRotationAngle(TabControl: TcxCustomTabControl): TcxPCRotationAngle;
procedure InitializeLineBoundsArray(TabControl: TcxCustomTabControl;
  var LineIndexBoundsA: TcxPCLineIndexBoundsArray);
procedure InitializeVisibleTabRange(TabControl: TcxCustomTabControl;
  var FirstIndex, LastIndex: Integer);
function InternalGetTextRotationAngle(TabControl: TcxCustomTabControl): TcxPCRotationAngle;
function InternalIsVerticalText(TabControl: TcxCustomTabControl): Boolean;
function  IsBottomToTopAlignment(TabControl: TcxCustomTabControl): Boolean;
function IsRightToLeftAlignment(TabControl: TcxCustomTabControl): Boolean;
function IsVerticalText(TabControl: TcxCustomTabControl): Boolean;
function PointGetter(APoint: TPoint; GetY: Boolean): Longint;
procedure PointSetter(var APoint: TPoint; SetY: Boolean; Value: Longint);
procedure PrepareBitmap(Bitmap: TBitmap; ParametersSource: TcxCanvas; Size: TSize;
  BackgroundColor: TColor; ATransparent: Boolean);
function RemoveAccelChars(S: TCaption): TCaption;
procedure RotateBitmap(Bitmap: TBitmap; Angle: TcxPCRotationAngle);
procedure ValidateRect(var R: TRect);

implementation

uses
{$IFDEF VCL}
  dxThemeManager, dxUxTheme,
{$ENDIF}
  Math, cxPCConsts, cxPCPainters, cxPCPaintersFactory;

const
  InitialTimerDelay = 300;
  TimerDelay = 150;

{$IFNDEF VCL}
  VK_TAB = Key_Tab;
{$ENDIF}

{$IFDEF VCL}
var
  FBackgroundBitmap: TBitmap = nil;
  IsWin98Or2000: Boolean = False;
{$ENDIF}

procedure CorrectRect(var Rect: TRect; RectCorrection: TcxPCRectCorrection);
begin
  with Rect, RectCorrection do
  begin
    Inc(Top, dTop);
    Inc(Bottom, dBottom);
    Inc(Left, dLeft);
    Inc(Right, dRight);