cxgroupbox.pas

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

PAS
1,801
字号
{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       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 EXPRESSEDITORS 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 cxGroupBox;

{$I cxVer.inc}

interface

uses
  Windows, Messages,
  SysUtils, Classes, Controls, Graphics, Forms, cxControls, cxGraphics,
  cxLookAndFeels, cxContainer, cxEditPaintUtils, cxEdit,
  cxTextEdit, cxClasses, cxCheckBox, cxLookAndFeelPainters;

const
  cxGroupBox_SupportNonClientArea: Boolean = True;

type
  TcxCaptionAlignment = (alTopLeft, alTopCenter, alTopRight,
    alBottomLeft, alBottomCenter, alBottomRight,
    alLeftTop, alLeftCenter, alLeftBottom,
    alRightTop, alRightCenter, alRightBottom,
    alCenterCenter);

  TcxPanelOffice11BackgroundKind = (pobkGradient, pobkOffice11Color, pobkStyleColor);

  { TcxGroupBoxButtonViewInfo }

  TcxGroupBoxButtonViewInfo = class(TcxEditButtonViewInfo)
  public
    Caption: string;
    Column, Row: Integer;
    function GetGlyphRect(ACanvas: TcxCanvas; AGlyphSize: TSize; AAlignment: TLeftRight; AIsPaintCopy: Boolean): TRect; virtual;
  end;

  { TcxGroupBoxViewInfo }

  TcxCustomGroupBox = class;

  TcxGroupBoxViewInfo = class(TcxCustomTextEditViewInfo)
  private
    function GetCaptionRectIndent: TRect;
    function GetControlRect: TRect;
    function GetEdit: TcxCustomGroupBox;
    function CalcOffsetBoundsForPanel: TRect;
    procedure CalcBoundsForPanel;
    function GetFrameBounds: TRect;
    procedure CalcTextBoundsForPanel;
    function CalcCorrectionBoundsForPanel: TRect;
    procedure AdjustTextBoundsForPanel;
    procedure AdjustCaptionBoundsForPanel;
    procedure DrawHorizontalTextCaption(ACanvas: TcxCanvas);
    procedure DrawVerticalTextCaption(ACanvas: TcxCanvas);
    procedure DrawFrame(ACanvas: TcxCanvas; R: TRect);
    function GetThemeBackgroundRect(ACanvas: TcxCanvas): TRect;
    function GetBoundsForPanel: TRect;
    procedure DrawUsualBackground(ACanvas: TcxCanvas);
    procedure DrawNativeBackground(ACanvas: TcxCanvas; const ACaptionRect: TRect);
    procedure DrawNativeGroupBoxBackground(ACanvas: TcxCanvas);
    procedure DrawNativePanelBackground(ACanvas: TcxCanvas; const ACaptionRect: TRect);
    procedure DrawOffice11PanelBackground(ACanvas: TcxCanvas; const R: TRect);
    procedure InternalDrawBackground(ACanvas: TcxCanvas);
  protected
    procedure AdjustCaptionRect(ACaptionPosition: TcxGroupBoxCaptionPosition); virtual;
    procedure DrawCaption(ACanvas: TcxCanvas); virtual;
    function GetButtonViewInfoClass: TcxEditButtonViewInfoClass; override;
    procedure InternalPaint(ACanvas: TcxCanvas); override;
    property ControlRect: TRect read GetControlRect;
  public
    Alignment: TLeftRight;
    CaptionRect: TRect;
    IsDesigning: Boolean;
    TextRect: TRect;
    constructor Create; override;
    destructor Destroy; override;
    property Edit: TcxCustomGroupBox read GetEdit;
  end;

  { TcxGroupBoxViewData }

  TcxGroupBoxViewData = class(TcxCustomEditViewData)
  private
    function GetCaptionRect(ACanvas: TcxCanvas): TRect;
    function GetShadowWidth: Integer;
    function HasNonClientArea: Boolean;
    procedure AdjustHorizontalCaptionRect(var R: TRect);
    procedure AdjustVerticalCaptionRect(var R: TRect);
    function GetEdit: TcxCustomGroupBox;
    procedure CalcRects(ACanvas: TcxCanvas; AEditViewInfo: TcxGroupBoxViewInfo);
  protected
    function GetBorderExtentBySkinPainter: TRect; virtual;
    function GetContainerState(const ABounds: TRect; const P: TPoint;
      Button: TcxMouseButton; Shift: TShiftState;
      AIsMouseEvent: Boolean): TcxContainerState; override;
  public
    procedure Calculate(ACanvas: TcxCanvas; const ABounds: TRect; const P: TPoint;
      Button: TcxMouseButton; Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
      AIsMouseEvent: Boolean); override;
    function GetBorderColor: TColor; override;
    function GetBorderExtent: TRect; override;
    function GetClientExtent(ACanvas: TcxCanvas;
      AViewInfo: TcxCustomEditViewInfo): TRect; override;
    function HasShadow: Boolean; override;
    class function IsNativeStyle(ALookAndFeel: TcxLookAndFeel): Boolean; override;
    property Edit: TcxCustomGroupBox read GetEdit;
  end;

  { TcxButtonGroupViewData }

  TcxCustomButtonGroupProperties = class;

  TcxEditMetrics = record
    AutoHeightColumnWidthCorrection, AutoHeightWidthCorrection,
    ColumnWidthCorrection, WidthCorrection: Integer;
    ClientLeftBoundCorrection, ClientWidthCorrection, ColumnOffset: Integer;
    ButtonSize: TSize;
  end;

  { TcxButtonGroupViewInfo }

  TcxButtonGroupViewInfo = class(TcxGroupBoxViewInfo)
  protected
    procedure DrawEditButton(ACanvas: TcxCanvas; AButtonVisibleIndex: Integer); override;
    procedure DrawButtonCaption(ACanvas: TcxCanvas;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect); virtual; abstract;
    procedure DrawButtonGlyph(ACanvas: TcxCanvas;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect); virtual; abstract;
    function GetGlyphSize: TSize; virtual;
    function IsButtonGlypthTransparent(AButtonViewInfo: TcxGroupBoxButtonViewInfo): Boolean; virtual; abstract;
  public
    CaptionExtent: TRect;
    GlyphSize: TSize;
  end;

  TcxButtonGroupViewData = class(TcxGroupBoxViewData)
  private
    function GetProperties: TcxCustomButtonGroupProperties;
  protected
    procedure CalculateButtonPositions(ACanvas: TcxCanvas;
      AViewInfo: TcxCustomEditViewInfo); virtual;
    procedure CalculateButtonViewInfos(AViewInfo: TcxCustomEditViewInfo); virtual;
    function GetDrawTextFlags: Integer; virtual;
    procedure GetEditMetrics(AAutoHeight: Boolean; ACanvas: TcxCanvas;
      out AMetrics: TcxEditMetrics); virtual; abstract;
    function GetCaptionRectExtent: TRect; virtual;
    procedure CalculateButtonNativeState(AViewInfo: TcxCustomEditViewInfo;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo); virtual; abstract;
  public
    procedure Calculate(ACanvas: TcxCanvas; const ABounds: TRect; const P: TPoint;
      Button: TcxMouseButton; Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
      AIsMouseEvent: Boolean); override;
    procedure CalculateButtonsViewInfo(ACanvas: TcxCanvas; const ABounds: TRect;
      const P: TPoint; Button: TcxMouseButton; Shift: TShiftState;
      AViewInfo: TcxCustomEditViewInfo; AIsMouseEvent: Boolean); override;
    function GetEditConstantPartSize(ACanvas: TcxCanvas;
      const AEditSizeProperties: TcxEditSizeProperties;
      var MinContentSize: TSize; AViewInfo: TcxCustomEditViewInfo = nil): TSize; override;
    class function IsButtonNativeStyle(ALookAndFeel: TcxLookAndFeel): Boolean; virtual;
    property Properties: TcxCustomButtonGroupProperties read GetProperties;
  end;

  TcxButtonGroupViewDataClass = class of TcxButtonGroupViewData;

  { TcxCustomGroupBoxProperties }

  TcxCustomGroupBoxProperties = class(TcxCustomEditProperties)
  protected
    class function GetViewDataClass: TcxCustomEditViewDataClass; override;
  public
    class function GetContainerClass: TcxContainerClass; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
  end;

  { TcxButtonGroupItem }

  TcxButtonGroupItem = class(TCollectionItem)
  private
    FCaption: TCaption;
    FEnabled: Boolean;
    FTag: TcxTag;
    function GetIsCollectionDestroying: Boolean;
    function IsTagStored: Boolean;
    procedure SetCaption(const Value: TCaption);
    procedure SetEnabled(Value: Boolean);
  protected
    procedure DoChanged(ACollection: TCollection; ACollectionOperation: TcxCollectionOperation;
      AIndex: Integer = -1);
    property Caption: TCaption read FCaption write SetCaption;
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property IsCollectionDestroying: Boolean read GetIsCollectionDestroying;
    property Tag: TcxTag read FTag write FTag stored IsTagStored;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetCaption: TCaption;
  end;

  { TcxButtonGroupItems }

  TcxButtonGroupItems = class(TOwnedCollection,
    IUnknown, IcxCheckItems)
  private
    FChangedItemIndex: Integer;
    FChangedItemOperation: TcxCollectionOperation;
    FIsDestroying: Boolean;
    FItemChanged: Boolean;
    function GetItem(Index: Integer): TcxButtonGroupItem;
    procedure SetItem(Index: Integer; Value: TcxButtonGroupItem);

    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    { IcxCheckItems }
    function IcxCheckItems.GetCaption = CheckItemsGetCaption;
    function IcxCheckItems.GetCount = CheckItemsGetCount;
    function CheckItemsGetCaption(Index: Integer): string;
    function CheckItemsGetCount: Integer;
  protected
    procedure Update(Item: TCollectionItem); override;
    property ChangedItemIndex: Integer read FChangedItemIndex;
    property ChangedItemOperation: TcxCollectionOperation
      read FChangedItemOperation;
    property IsDestroying: Boolean read FIsDestroying;
    property ItemChanged: Boolean read FItemChanged;
  public
    destructor Destroy; override;
    procedure InternalNotify(AItem: TcxButtonGroupItem; AItemIndex: Integer;
      AItemOperation: TcxCollectionOperation);
    property Items[Index: Integer]: TcxButtonGroupItem
      read GetItem write SetItem; default;
  end;

  TcxButtonGroupItemsClass = class of TcxButtonGroupItems;

  { TcxCustomButtonGroupProperties }

  TcxCustomButtonGroupProperties = class(TcxCustomGroupBoxProperties)
  private
    FColumns: Integer;
    FItems: TcxButtonGroupItems;
    FWordWrap: Boolean;
    procedure SetColumns(Value: Integer);
    procedure SetItems(Value: TcxButtonGroupItems);
    procedure SetWordWrap(Value: Boolean);
  protected
    class function GetViewDataClass: TcxCustomEditViewDataClass; override;
    function CreateItems: TcxButtonGroupItems; virtual;
    function GetButtonsPerColumn: Integer;
    function GetColumnCount: Integer; virtual;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CreatePreviewProperties: TcxCustomEditProperties; override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetSpecialFeatures: TcxEditSpecialFeatures; override;
    function GetSupportedOperations: TcxEditSupportedOperations; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
    // !!!
    property Columns: Integer read FColumns write SetColumns default 1;
    property Items: TcxButtonGroupItems read FItems write SetItems;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  end;

  { TcxPanelStyle }

  TcxPanelStyle = class(TPersistent)
  private
    FActive: Boolean;
    FCaptionIndent: Integer;
    FEdit: TcxCustomGroupBox;
    FOfficeBackgroundKind: TcxPanelOffice11BackgroundKind;
    FWordWrap: Boolean;

    procedure SetActive(AValue: Boolean);
    procedure SetCaptionIndent(AValue: Integer);
    procedure SetOfficeBackgroundKind(AValue: TcxPanelOffice11BackgroundKind);
    procedure SetWordWrap(AValue: Boolean);
  protected
    procedure Update;
    property Edit: TcxCustomGroupBox read FEdit;
  public
    constructor Create(AOwner: TcxCustomGroupBox); virtual;
    procedure Assign(ASource: TPersistent); override;
  published
    property Active: Boolean read FActive write SetActive default False;
    property CaptionIndent: Integer read FCaptionIndent write SetCaptionIndent default 2;
    property OfficeBackgroundKind: TcxPanelOffice11BackgroundKind read FOfficeBackgroundKind
      write SetOfficeBackgroundKind default pobkOffice11Color;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  end;

  { TcxCustomGroupBox }

  TcxGroupBoxCustomDrawEvent = procedure (Sender: TcxCustomGroupBox; var ADone: Boolean) of object;
  TcxGroupBoxMeasureCaptionHeightEvent = procedure (Sender: TcxCustomGroupBox; const APainter: TcxCustomLookAndFeelPainterClass; var ACaptionHeight: Integer) of object;
  TcxGroupBoxCustomDrawElementEvent = procedure (Sender: TcxCustomGroupBox; ACanvas: TCanvas; const ABounds: TRect; const APainter: TcxCustomLookAndFeelPainterClass; var ADone: Boolean) of object;

  TcxCustomGroupBox = class(TcxCustomEdit)
  private
    FAlignment: TcxCaptionAlignment;
    FCaptionBkColor: TColor; // deprecated
    FCaptionFont: TFont;
    FIsAccelCharHandling: Boolean;
    FPanelStyle: TcxPanelStyle;
    FVisibleCaption: string;
    FOnCustomDraw: TcxGroupBoxCustomDrawEvent;
  {$IFDEF DELPHI7}
    FOnCustomDrawCaption: TcxGroupBoxCustomDrawElementEvent;
    FOnCustomDrawContentBackground: TcxGroupBoxCustomDrawElementEvent;
    FOnMeasureCaptionHeight: TcxGroupBoxMeasureCaptionHeightEvent;
  {$ENDIF}

    procedure CalculateVisibleCaption;
    function GetCaptionBkColor: TColor; // deprecated
    function GetColor: TColor; // deprecated
    function GetFont: TFont; // deprecated
    function IsSkinAvailable: Boolean;

    procedure UpdateCaption;
    procedure UpdateNonClientArea;
    function GetPanelStyleCaptionDrawingFlags: Cardinal;
    function GetHorizontalCaptionIndent: Integer;
    function GetVerticalCaptionIndent: Integer;
    function GetVisibleCaption: string;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?