cxpc.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressPageControl                                           }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSPAGECONTROL AND ALL            }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxPC;

{$I cxVer.inc}

interface

uses
  Windows, Messages, Classes, Controls, Forms, Graphics, ImgList,
  SysUtils, cxClasses, cxControls, cxGraphics, cxLookAndFeels, cxPCGoDialog;

type
  TcxPCRectCorrection = record
    dLeft, dTop, dRight, dBottom: Integer;
  end;

  TcxPCOption = (pcoAlwaysShowGoDialogButton, pcoCloseButton,
    pcoFixedTabWidthWhenRotated, pcoGoDialog, pcoGradient,
    pcoGradientClientArea, pcoNoArrows, pcoRedrawOnResize, pcoSort,
    pcoTopToBottomText, pcoUsePageColorForTab);
  TcxPCOptions = set of TcxPCOption;
  
const
  cxPCEmptyRectCorrection: TcxPCRectCorrection =
    (dLeft: 0; dTop: 0; dRight: 0; dBottom: 0);

  TabsContainerOffset = 2;
  TabsContainerBaseWidth = 3;

  cxPCNoStyle = -1;
  cxPCDefaultStyle = 0;
  cxPCDefaultStyleName = 'Default';

  cxPCDefaultOptions = [pcoAlwaysShowGoDialogButton, pcoGradient,
    pcoGradientClientArea, pcoRedrawOnResize];

type
  TcxPCStyleID = -1 .. High(Integer);
  TcxPCStandardStyle = (tsTabs, tsButtons, tsFlatButtons);

  TcxTabPosition = (tpTop, tpBottom, tpLeft, tpRight);

  TcxTabSlantKind = (skCutCorner, skSlant);
  TcxTabSlantPosition = (spLeft, spRight);
  TcxTabSlantPositions = set of TcxTabSlantPosition;

  TcxCustomTabControl = class;
  TcxTab = class;
  TcxTabSheet = class;

  TcxDrawTabEvent = procedure(AControl: TcxCustomTabControl; ATab: TcxTab;
    var DefaultDraw: Boolean) of object;
  TcxDrawTabExEvent = procedure(AControl: TcxCustomTabControl; ATab: TcxTab;
    Font: TFont) of object;
  TcxGetTabImageEvent = procedure(Sender: TObject; TabIndex: Integer;
    var ImageIndex: Integer) of object;
  TcxPageChangingEvent = procedure(Sender: TObject; NewPage: TcxTabSheet; var AllowChange: Boolean) of object;
  TcxPCCanCloseEvent = procedure(Sender: TObject; var ACanClose: Boolean) of object;
  TcxTabChangedEvent = procedure(Sender: TObject; TabID: Integer) of object;
  TcxTabChangingEvent = procedure(Sender: TObject; var AllowChange: Boolean) of object;

  TcxPCNavigatorButton = (nbTopLeft, nbBottomRight, nbGoDialog, nbClose);
  TcxPCNavigatorButtons = set of TcxPCNavigatorButton;
  TcxPCNavigatorButtonIndex = TcxPCNavigatorButtons;
  TcxPCNavigatorButtonState = (nbsNormal, nbsPressed, nbsHotTrack, nbsDisabled);
  TcxPCNavigatorPosition = (npLeftTop, npLeftBottom, npRightTop, npRightBottom);

  TcxPCTabsPosition = record
    ExtendedTabsRect: TRect;
    ExtendedTopOrLeftTabsRectBottomOrRightBorderOffset: Integer;
    ExtendedBottomOrRightTabsRectTopOrLeftBorderOffset: Integer;
    MinDistanceBetweenTopOrLeftAndBottomOrRightExtendedTabsRects: Integer;
    NormalRowWidth: Integer;
    NormalTabsRect: TRect;
  end;

  TcxPCWOffset = record
    Left, Right: Integer;
  end;

  TcxPCDistance = record
    dw, dh: Integer;
  end;

  TcxPCTabPosition = record
    TabNormalPosition: TPoint;
    TabNormalWidth: Integer; // Height is in TcxTabs
    TabRectCorrection: TcxPCRectCorrection;
  end;

  TcxPCIndexInterval = record
    Left, Right: Integer;
  end;
  TcxPCLineIndexBoundsArray = array of TcxPCIndexInterval;

  TcxPCTabIndex = Integer;

  TcxPCTabPropertyChanged = (tpcNotSpecified, tpcColor, tpcEnabled, tpcFocused,
    tpcHighlighted, tpcHotTrack, tpcIsMainTab, tpcLayout, tpcPressed,
    tpcSelected, tpcTracking);

  TcxPCTabNotification = (tnDeleting);

  TcxPCOutTabImageAndTextData = record
    TabImageRect: TRect;
    TabTextRect: TRect;
    TabVisibleIndex: Integer;
  end;

  TcxPCImageListRotatedImagesElement = record
    BackgroundColor: TColor;
    Bitmap: TBitmap;
    IsBackgroundColorSpecified: Boolean;
  end;
  TcxPCImageListRotatedImagesElementArray =
    array of TcxPCImageListRotatedImagesElement;

  TcxTabs = class;
  TcxTabSlants = class;

  TcxTab = class(TPersistent)
  private
    FCaption: string; // type of TStrings' item
    FColor: TColor;
    FEnabled: Boolean;
    FHighlighted: Boolean;
    FImageIndex: TImageIndex;
    FIndex: Integer;
    FObject: TObject;
    FPaintBitmap: TBitmap;
    FRow: Integer;
    FSelected: Boolean;
    FTabPosition: TcxPCTabPosition;
    FTabs: TcxTabs;
    FVerticalTextBitmap: TBitmap;
    FVisible: Boolean;
    FVisibleRow: Integer;
    function GetFullRect: TRect;
    function GetHotTrack: Boolean;
    function GetImageIndex: TImageIndex;
    function GetIsMainTab: Boolean;
    function GetNormalLongitudinalSize: Integer;
    function GetNormalRect: TRect;
    function GetPaintingPosition: TcxTabPosition;
    function GetPaintingPositionIndex: Integer;
    function GetParentControl: TcxCustomTabControl;
    function GetPressed: Boolean;
    function GetRealEnabled: Boolean;
    function GetRealVisible: Boolean;
    function GetTracking: Boolean;
    function GetVisibleIndex: Integer;
    function GetVisibleRect: TRect;
    procedure InternalSetCaption(const Value: string);
    function IsImageIndexStored: Boolean;
    procedure SetCaption(const Value: string);
    procedure SetColor(Value: TColor);
    procedure SetEnabled(const Value: Boolean);
    procedure SetHighlighted(const Value: Boolean);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetSelected(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure Changed(ATabPropertyChanged: TcxPCTabPropertyChanged);
    procedure ValidateImageIndex;
    property NormalLongitudinalSize: Integer read GetNormalLongitudinalSize;
    property ParentControl: TcxCustomTabControl read GetParentControl;
    property Tabs: TcxTabs read FTabs;
    property VerticalTextBitmap: TBitmap read FVerticalTextBitmap;
  public
    constructor Create(ATabs: TcxTabs; AIndex: Integer);
    destructor Destroy; override;
    procedure InitializePaintBitmap;
    procedure ResetPaintBitmap;
    procedure ResetVerticalTextBitmap;
    property FullRect: TRect read GetFullRect;
    property HotTrack: Boolean read GetHotTrack;
    property Index: Integer read FIndex;
    property IsMainTab: Boolean read GetIsMainTab;
    property NormalRect: TRect read GetNormalRect;
    property PaintBitmap: TBitmap read FPaintBitmap;
    property PaintingPosition: TcxTabPosition read GetPaintingPosition;
    property PaintingPositionIndex: Integer read GetPaintingPositionIndex;
    property Pressed: Boolean read GetPressed;
    property RealEnabled: Boolean read GetRealEnabled;
    property RealVisible: Boolean read GetRealVisible;
    property Tracking: Boolean read GetTracking;
    property VisibleIndex: Integer read GetVisibleIndex;
    property VisibleRect: TRect read GetVisibleRect;
    property VisibleRow: Integer read FVisibleRow;
  published
    property Caption: string read FCaption write SetCaption;
    property Color: TColor read FColor write SetColor default clDefault;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Highlighted: Boolean read FHighlighted write SetHighlighted;
    property ImageIndex: TImageIndex
      read GetImageIndex write SetImageIndex stored IsImageIndexStored;
    property Selected: Boolean read FSelected write SetSelected;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

  TcxTabs = class(TStrings)
  private
    FNotification: Boolean;
    FParent: TcxCustomTabControl;
    FTabNormalHeight: Integer;
    FTabsItemA: array of TcxTab;
    FUpdating: Boolean;
    function GetTab(TabIndex: Integer): TcxTab;
    function GetVisibleTab(TabVisibleIndex: Integer): TcxTab;
    procedure SetTab(Index: Integer; const Value: TcxTab);
    function GetVisibleTabsCount: Integer;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure Changed(VisibleIndex: Integer = -1; TabPropertyChanged: TcxPCTabPropertyChanged = tpcLayout);
    procedure Notify(Index: Integer; Action: TcxPCTabNotification); virtual;
    class procedure OutError(SourceMethodName: TCaption; Index: Integer); virtual;
    procedure SetHotTrack(VisibleIndex: Integer);
    procedure SetMainTab;
    procedure SetTracking(NewTracking: Integer);
    procedure UpdateTabIndexes(FirstIndex, LastIndex: Integer);
    procedure ValidateImageIndexes;
    property Parent: TcxCustomTabControl read FParent;
  public
    constructor Create(AParent: TcxCustomTabControl);
    destructor Destroy; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
    procedure ResetTabVerticalTextBitmaps;
  public
    property TabNormalHeight: Integer read FTabNormalHeight;
    property Tabs[TabIndex: Integer]: TcxTab read GetTab write SetTab; default;
    property VisibleTabsCount: Integer read GetVisibleTabsCount;
    property VisibleTabs[TabVisibleIndex: Integer]: TcxTab read GetVisibleTab;
  end;

  TcxVisibleTabList = class
  private
    FParent: TcxCustomTabControl;
    TabIndexA: array of TcxPCTabIndex;
    function GetCount: Integer;
    function GetTab(TabVisibleIndex: Integer): TcxTab;
    procedure OutError(SourceMethodName: TCaption; Msg: string);
  public
    constructor Create(AParent: TcxCustomTabControl);
    destructor Destroy; override;

    function FindVisibleTab(TabIndex: TcxPCTabIndex; var TabVisibleIndex: Integer): Boolean;
    procedure HideTab(TabIndex: TcxPCTabIndex);
    procedure ShowTab(TabIndex: TcxPCTabIndex);
    procedure Update;
    function TabVisibleIndexOf(TabIndex: TcxPCTabIndex): Integer;

    property Count: Integer read GetCount;
    property Tabs[TabVisibleIndex: Integer]: TcxTab read GetTab; default;
  end;

  TcxPCPainterParentInfo = class
  private
    FParent: TcxCustomTabControl;
    function GetActivePage: TcxTabSheet;
    function GetCanvas: TcxCanvas;
    function GetFont: TFont;
    function GetIsTabsContainer: Boolean;
    function GetTabPosition: TcxTabPosition;
    function GetNavigatorPositione: TcxPCNavigatorPosition;
    function GetMultiLine: Boolean;
    function GetNavigatorButtonState(
      Index: TcxPCNavigatorButton): TcxPCNavigatorButtonState;
    function GetVisibleTab(TabVisibleIndex: Integer): TcxTab;
    function GetTabHeight: Smallint;
    function GetTabsOnBothSides: Boolean;
    function GetTabWidth: Smallint;
    function GetMainTabVisibleIndex: Integer;
    function GetOptions: TcxPCOptions;
    function GetPageColor(ATabVisibleIndex: Integer): TColor;
    function GetPage(ATabVisibleIndex: Integer): TcxTabSheet;
    function GetRaggedRight: Boolean;
    function GetTabColor(ATabVisibleIndex: Integer): TColor;
    function GetTabSlants: TcxTabSlants;
    function GetNavigatorButtons: TcxPCNavigatorButtons;
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetExtendedBottomOrRightTabsRect: TRect;
    function GetExtendedTopOrLeftTabsRect: TRect;
    function GetRowCount: Integer;
    function GetScrollOpposite: Boolean;