cxcontainer.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressCommonLibrary                                         }
{                                                                    }
{       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 EXPRESSCOMMONLIBRARY 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.                                         }
{                                                                    }
{********************************************************************}

{$DEFINE USETCXSCROLLBAR}

unit cxContainer;

{$I cxVer.inc}

interface

uses
  Windows, Messages,
  dxThemeManager, dxUxTheme,
  Classes, Controls, Forms, Graphics, Menus, StdCtrls, SysUtils, cxClasses,
  cxControls, cxGraphics, cxLookAndFeels, cxScrollBar, cxLookAndFeelPainters;

const
  CM_CLOSEPOPUPWINDOW = WM_DX + 25;
  CM_SHOWPOPUPWINDOW = WM_DX + 26;
  CM_SHORTREFRESHCONTAINER = WM_DX + 27;
  CM_UPDATESCROLLBARS = WM_DX + 28;
  CM_BUFFEREDPAINTONGLASS = WM_DX + 29;

  cxDefaultAutoCompleteDelay = 500;

  cxContainerMaxBorderWidth = 2;
  cxContainerShadowWidth = 3;

  cxEmptyBrush: TBrushHandle = 0;

  cxContainerDefaultBorderExtent: TRect = (
    Left: cxContainerMaxBorderWidth;
    Top: cxContainerMaxBorderWidth;
    Right: cxContainerMaxBorderWidth;
    Bottom: cxContainerMaxBorderWidth
  );

type
  TcxContainerBorderStyle = (cbsNone, cbsSingle, cbsThick, cbsFlat, cbs3D,
    cbsUltraFlat, cbsOffice11);
  TcxContainerHotState = (chsNoHotTrack, chsNormal, chsSelected);
  TcxContainerStateItem = (csNormal, csActive, csDisabled, csHotTrack);
  TcxContainerState = set of TcxContainerStateItem;
  TcxMouseButton = (cxmbNone, cxmbLeft, cxmbRight, cxmbMiddle);
  TcxNativeHandle = HWND;

  TcxContainerStyleValue = 0..SizeOf(Integer) * 8 - 1;
  TcxContainerStyleValues = set of TcxContainerStyleValue;

const
  csvBorderColor       = 0;
  csvBorderStyle       = 1;
  csvColor             = 2;
  csvEdges             = 3;
  csvFont              = 4;
  csvHotTrack          = 5;
  csvShadow            = 6;
  csvTextColor         = 7;
  csvTextStyle         = 8;
  csvTransparentBorder = 9;

  cxContainerStyleValueCount = 10;

  cxContainerStyleValueNameA: array[0..cxContainerStyleValueCount - 1] of string = (
    'BorderColor',
    'BorderStyle',
    'Color',
    'Edges',
    'Font',
    'HotTrack',
    'Shadow',
    'TextColor',
    'TextStyle',
    'TransparentBorder'
  );

type
  TcxContainer = class;
  TcxContainerClass = class of TcxContainer;

  { TcxContainerViewInfo }

  TcxContainerViewInfo = class
  private
    FBackgroundColor: TColor;
  protected
    procedure DrawBorder(ACanvas: TcxCanvas; R: TRect); virtual;
    function GetContainerBorderStyle: TcxContainerBorderStyle; virtual;
    procedure InternalPaint(ACanvas: TcxCanvas); virtual;
    procedure SetBackgroundColor(Value: TColor); virtual;
  public
    BorderColor: TColor;
    BorderRect: TRect;
    BorderStyle: TcxContainerBorderStyle;
    BorderWidth: Integer;
    Bounds: TRect;
    ClientRect: TRect;
    ContainerState: TcxContainerState;
    Edges: TcxBorders;
    HotState: TcxContainerHotState;
    NativePart: Integer;
    NativeState: Integer;
    NativeStyle: Boolean;
    Painter: TcxCustomLookAndFeelPainterClass;
    Shadow: Boolean;
    ThemedObjectType: TdxThemedObjectType;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
    constructor Create; virtual;
    procedure Assign(Source: TObject); virtual;
    function GetUpdateRegion(AViewInfo: TcxContainerViewInfo): TcxRegion; virtual;
    procedure Offset(DX, DY: Integer); virtual;
    procedure Paint(ACanvas: TcxCanvas); virtual;
  end;

  TcxContainerViewInfoClass = class of TcxContainerViewInfo;

  { TcxContainerStyle }

  TcxStyleController = class;

  TcxContainerStyleData = record
    Color: TColor;
    Font: TFont;
    FontColor: TColor;
  end;

  TcxContainerStyle = class(TcxInterfacedPersistent, IUnknown,  IdxSkinSupport)
  private
    FBorderColor: TColor;
    FBorderStyle: TcxContainerBorderStyle;
    FEdges: TcxBorders;
    FHotTrack: Boolean;
    FShadow: Boolean;
    FTransparentBorder: Boolean;

    FDirectAccessMode: Boolean;
    FFontAssignedValueLockCount: Integer;
    FIsDestroying: Boolean;
    FLookAndFeel: TcxLookAndFeel;
    FModified: Boolean;
    FOwner: TPersistent;
    FParentStyle: TcxContainerStyle;
    FState: TcxContainerStateItem;
    FTextStyle: TFontStyles;
    FUpdateCount: Integer;
    FVisibleFont: TFont;
    FOnChanged: TNotifyEvent;

    function GetAssignedValues: TcxContainerStyleValues;
    function GetBorderColor: TColor;
    function GetBorderStyle: TcxContainerBorderStyle;
    function GetEdges: TcxBorders;
    function GetFont: TFont;
    function GetHotTrack: Boolean;
    function GetShadow: Boolean;
    function GetTransparentBorder: Boolean;

    function InternalGetBorderColor(var BorderColor: TColor): Boolean;
    function InternalGetBorderStyle(var BorderStyle: TcxContainerBorderStyle): Boolean;
    function InternalGetEdges(var Edges: TcxBorders): Boolean;
    function InternalGetFont(var Font: TFont): Boolean;
    function InternalGetHotTrack(var HotTrack: Boolean): Boolean;
    function InternalGetShadow(var Shadow: Boolean): Boolean;
    function InternalGetTextColor(var TextColor: TColor): Boolean;
    function InternalGetTextStyle(var TextStyle: TFontStyles): Boolean;
    function InternalGetTransparentBorder(var TransparentBorder: Boolean): Boolean;

    function IsBorderColorStored: Boolean;
    function IsBorderStyleStored: Boolean;
    function IsColorStored: Boolean;
    function IsEdgesStored: Boolean;
    function IsFontStored: Boolean;
    function IsHotTrackStored: Boolean;
    function IsShadowStored: Boolean;
    function IsStyleControllerStored: Boolean;
    function IsTextColorStored: Boolean;
    function IsTextStyleStored: Boolean;
    function IsTransparentBorderStored: Boolean;

    procedure SetAssignedValues(Value: TcxContainerStyleValues);
    procedure SetBorderColor(Value: TColor);
    procedure SetBorderStyle(Value: TcxContainerBorderStyle);
    procedure SetColor(Value: TColor);
    procedure SetEdges(Value: TcxBorders);
    procedure SetFont(Value: TFont);
    procedure SetHotTrack(Value: Boolean);
    procedure SetShadow(Value: Boolean);
    procedure SetTextColor(Value: TColor);
    procedure SetTextStyle(Value: TFontStyles);
    procedure SetTransparentBorder(Value: Boolean);

    procedure CheckChanges;
    procedure CreateFont;
    function GetActiveStyleController: TcxStyleController;
    function GetBaseStyle: TcxContainerStyle;
    function GetContainer: TcxContainer;
    function GetLookAndFeel: TcxLookAndFeel;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues);
    procedure ReadIsFontAssigned(Reader: TReader);
    procedure RestoreFont(AFont: TFont);
    procedure SetLookAndFeel(Value: TcxLookAndFeel);
    procedure UpdateVisibleFont;
    procedure WriteIsFontAssigned(Writer: TWriter);
  protected
    FAssignedValues: TcxContainerStyleValues;
    FStyleController: TcxStyleController;
    procedure DefineProperties(Filer: TFiler); override;
    function BaseGetStyleController: TcxStyleController;
    procedure BaseSetStyleController(Value: TcxStyleController);
    procedure Changed; virtual;
    procedure ControllerChangedNotification(AStyleController: TcxStyleController); virtual;
    procedure ControllerFreeNotification(AStyleController: TcxStyleController); virtual;

    function DefaultBorderColor: TColor; virtual;
    function DefaultBorderStyle: TcxContainerBorderStyle; virtual;
    function DefaultColor: TColor; virtual;
    function DefaultEdges: TcxBorders; virtual;
    function DefaultHotTrack: Boolean; virtual;
    function DefaultShadow: Boolean; virtual;
    function DefaultTextColor: TColor; virtual;
    function DefaultTextStyle: TFontStyles; virtual;
    function DefaultTransparentBorder: Boolean; virtual;

    procedure FontChanged(Sender: TObject); virtual;
    function GetColor: TColor; virtual;
    function GetDefaultStyleController: TcxStyleController; virtual;
    function GetStyleColor: TColor; virtual;
    function GetTextColor: TColor; virtual;
    function GetTextStyle: TFontStyles; virtual;
    function InternalGetColor(var Color: TColor): Boolean;
    function InternalGetNotPublishedExtendedStyleValues: TcxContainerStyleValues; virtual;
    function IsBaseStyle: Boolean;
    function IsDestroying: Boolean;
    function IsFontAssignedValueLocked: Boolean;
    procedure LockFontAssignedValue(ALock: Boolean);
    procedure UpdateFont;
    property ParentStyle: TcxContainerStyle read FParentStyle;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  public
    StyleData: TcxContainerStyleData;
    constructor Create(AOwner: TPersistent; ADirectAccessMode: Boolean;
      AParentStyle: TcxContainerStyle = nil;
      AState: TcxContainerStateItem = csNormal); reintroduce; virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure EndUpdate;
    function GetStyleValue(const APropertyName: string;
      out StyleValue: TcxContainerStyleValue): Boolean;
    function GetStyleValueCount: Integer; virtual;
    function GetStyleValueName(AStyleValue: TcxContainerStyleValue;
      out StyleValueName: string): Boolean; virtual;
    function GetVisibleFont: TFont;
    function HasBorder: Boolean; virtual;
    function IsExtendedStylePropertyPublished(
      const APropertyName: string): Boolean;
    function IsValueAssigned(AValue: TcxContainerStyleValue): Boolean; virtual;
    procedure RestoreDefaults; virtual;
    property ActiveStyleController: TcxStyleController read GetActiveStyleController;
    property BaseStyle: TcxContainerStyle read GetBaseStyle;
    property Container: TcxContainer read GetContainer;
    property DirectAccessMode: Boolean read FDirectAccessMode;
    property State: TcxContainerStateItem read FState;
  published
    property AssignedValues: TcxContainerStyleValues read GetAssignedValues
      write SetAssignedValues stored False;
    property BorderColor: TColor read GetBorderColor write SetBorderColor
      stored IsBorderColorStored;
    property BorderStyle: TcxContainerBorderStyle read GetBorderStyle
      write SetBorderStyle stored IsBorderStyleStored;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Edges: TcxBorders read GetEdges write SetEdges stored IsEdgesStored;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    property HotTrack: Boolean read GetHotTrack write SetHotTrack stored IsHotTrackStored;
    property LookAndFeel: TcxLookAndFeel read GetLookAndFeel
      write SetLookAndFeel;
    property Shadow: Boolean read GetShadow write SetShadow stored IsShadowStored;
    property StyleController: TcxStyleController read BaseGetStyleController
      write BaseSetStyleController stored IsStyleControllerStored;
    property TextColor: TColor read GetTextColor write SetTextColor
      stored IsTextColorStored;
    property TextStyle: TFontStyles read GetTextStyle write SetTextStyle
      stored IsTextStyleStored;
    property TransparentBorder: Boolean read GetTransparentBorder
      write SetTransparentBorder stored IsTransparentBorderStored;
  end;

  TcxCustomContainerStyle = TcxContainerStyle; // TODO Remove

  TcxContainerStyleClass = class of TcxContainerStyle;

  { TcxContainerStyles }

  TcxContainerStyles = class
  private
    FStyles: array[TcxContainerStateItem] of TcxContainerStyle;
    function GetStyle(AState: TcxContainerStateItem): TcxContainerStyle;
    function GetStyleDisabled: TcxContainerStyle;
    function GetStyleFocused: TcxContainerStyle;
    function GetStyleHot: TcxContainerStyle;
    function GetStyleNormal: TcxContainerStyle;
    procedure SetOnChanged(Value: TNotifyEvent);
    procedure SetStyle(AState: TcxContainerStateItem; Value: TcxContainerStyle);
    procedure SetStyleDisabled(Value: TcxContainerStyle);
    procedure SetStyleFocused(Value: TcxContainerStyle);
    procedure SetStyleHot(Value: TcxContainerStyle);
    procedure SetStyleNormal(Value: TcxContainerStyle);
  public
    constructor Create(AOwner: TPersistent;
      AStyleClass: TcxContainerStyleClass); virtual;
    destructor Destroy; override;
    procedure RestoreDefaults;
    property Style: TcxContainerStyle read GetStyleNormal write SetStyleNormal;
    property StyleDisabled: TcxContainerStyle read GetStyleDisabled
      write SetStyleDisabled;
    property StyleFocused: TcxContainerStyle read GetStyleFocused
      write SetStyleFocused;
    property StyleHot: TcxContainerStyle read GetStyleHot
      write SetStyleHot;
    property Styles[AState: TcxContainerStateItem]: TcxContainerStyle