cxcheckgroup.pas

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

PAS
1,310
字号

{********************************************************************}
{                                                                    }
{       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 cxCheckGroup;

{$I cxVer.inc}

interface

uses
  Windows, Classes, cxContainer, cxEdit, cxGroupBox, Controls, cxCheckBox, cxGraphics,
  Graphics, Messages, cxFilterControlUtils, cxCheckComboBox, cxLookAndFeels,
  cxLookAndFeelPainters;

type
  { TcxCheckGroupItem }

  TcxCheckGroupItem = class(TcxButtonGroupItem)
  published
    property Caption;
    property Enabled;
    property Tag;
  end;

  { TcxCheckGroupItems }

  TcxCheckGroupItems = class(TcxButtonGroupItems)
  private
    function GetItem(Index: Integer): TcxCheckGroupItem;
    procedure SetItem(Index: Integer; Value: TcxCheckGroupItem);
  public
    function Add: TcxCheckGroupItem;
    property Items[Index: Integer]: TcxCheckGroupItem
      read GetItem write SetItem; default;
  end;

  { TcxCheckGroupButtonViewInfo }

  TcxCheckGroupButtonViewInfo = class(TcxGroupBoxButtonViewInfo)
  public
    State: TcxCheckBoxState;
    function GetGlyphRect(ACanvas: TcxCanvas; AGlyphSize: TSize; AAlignment: TLeftRight; AIsPaintCopy: Boolean): TRect; override;
  end;

  TcxCustomCheckGroup = class;

  { TcxCheckGroupViewInfo }

  TcxCheckGroupViewInfo = class(TcxButtonGroupViewInfo)
  private
    function GetEdit: TcxCustomCheckGroup;
  protected
    procedure DrawButtonCaption(ACanvas: TcxCanvas;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect); override;
    procedure DrawButtonGlyph(ACanvas: TcxCanvas;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect); override;
    function GetButtonViewInfoClass: TcxEditButtonViewInfoClass; override;
    function IsButtonGlypthTransparent(AButtonViewInfo: TcxGroupBoxButtonViewInfo): Boolean; override;

    procedure SetOnDrawBackground(AValue: TcxEditDrawBackgroundEvent); override;
  public
    CheckBorderStyle: TcxEditCheckBoxBorderStyle;
    property Edit: TcxCustomCheckGroup read GetEdit;
  end;

  { TcxCheckGroupViewData }

  TcxCheckGroupViewData = class(TcxButtonGroupViewData)
  protected
    procedure CalculateButtonNativeState(AViewInfo: TcxCustomEditViewInfo;
      AButtonViewInfo: TcxGroupBoxButtonViewInfo); override;
    function GetCaptionRectExtent: TRect; override;
    procedure GetEditMetrics(AAutoHeight: Boolean; ACanvas: TcxCanvas;
      out AMetrics: TcxEditMetrics); override;
  public
    procedure Calculate(ACanvas: TcxCanvas; const ABounds: TRect; const P: TPoint;
      Button: TcxMouseButton; Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
      AIsMouseEvent: Boolean); override;
    procedure EditValueToDrawValue(ACanvas: TcxCanvas; const AEditValue: TcxEditValue;
      AViewInfo: TcxCustomEditViewInfo); override;
  end;

  { TcxCustomCheckGroupProperties }

  TcxCustomCheckGroupProperties = class(TcxCustomButtonGroupProperties)
  private
    FAllowGrayed: Boolean;
    FEditValueFormat: TcxCheckStatesValueFormat;
    FGlyph: TBitmap;
    FGlyphCount: Integer;
    FItemAlignment: TLeftRight;
    FOnEditValueToStates: TcxValueToCheckStatesEvent;
    FOnStatesToEditValue: TcxCheckStatesToValueEvent;
    function GetGlyph: TBitmap;
    function GetItems: TcxCheckGroupItems;
    procedure GlyphChanged(Sender: TObject);
    procedure SetAllowGrayed(Value: Boolean);
    procedure SetEditValueFormat(Value: TcxCheckStatesValueFormat);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGlyphCount(Value: Integer);
    procedure SetItemAlignment(Value: TLeftRight);
    procedure SetItems(Value: TcxCheckGroupItems);
  protected
    function CreateItems: TcxButtonGroupItems; override;
    class function GetViewDataClass: TcxCustomEditViewDataClass; override;
    function HasDisplayValue: Boolean; override;
    procedure CalculateCheckStatesByEditValue(Sender: TObject;
      const AEditValue: TcxEditValue); virtual;
    procedure CalculateEditValueByCheckStates(Sender: TObject;
      out AEditValue: TcxEditValue); virtual;
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CompareDisplayValues(
      const AEditValue1, AEditValue2: TcxEditValue): Boolean; override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetDisplayText(const AEditValue: TcxEditValue;
      AFullText: Boolean = False; AIsInplace: Boolean = True): WideString; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
    // !!!
    property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed
      default False;
    property EditValueFormat: TcxCheckStatesValueFormat read FEditValueFormat
      write SetEditValueFormat default cvfIndices;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphCount: Integer read FGlyphCount write SetGlyphCount default 6;
    property ItemAlignment: TLeftRight read FItemAlignment
      write SetItemAlignment default taLeftJustify;
    property Items: TcxCheckGroupItems read GetItems write SetItems;
    property OnEditValueToStates: TcxValueToCheckStatesEvent
      read FOnEditValueToStates write FOnEditValueToStates;
    property OnStatesToEditValue: TcxCheckStatesToValueEvent
      read FOnStatesToEditValue write FOnStatesToEditValue;
  end;

  { TcxCheckGroupProperties }

  TcxCheckGroupProperties = class(TcxCustomCheckGroupProperties)
  published
    property AllowGrayed;
    property AssignedValues;
    property ClearKey;
    property Columns;
    property EditValueFormat;
    property Glyph;
    property GlyphCount;
    property ImmediatePost;
    property ItemAlignment;
    property Items;
    property ReadOnly;
    property WordWrap;
    property OnChange;
    property OnEditValueChanged;
    property OnEditValueToStates;
    property OnStatesToEditValue;
  end;

  { TcxCheckGroupCheckButtonViewInfo }

  TcxCheckGroupCheckButtonViewInfo = class(TcxCustomCheckBoxViewInfo)
  protected
    procedure InternalPaint(ACanvas: TcxCanvas); override;
  end;

  { TcxCheckGroupButtonProperties }

  TcxCheckGroupButtonProperties = class(TcxCheckBoxProperties)
  protected
    function InternalGetGlyph: TBitmap; override;
    function IsEmbeddedEdit: Boolean; override;
  public
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
  end;

  { TcxCheckGroupButton }

  TcxCheckGroupButton = class(TcxCheckBox, IcxContainerInnerControl)
  private
    FColumn: Integer;
    FRow: Integer;
    function GetCheckGroup: TcxCustomCheckGroup;
  protected
    function CanAutoSize: Boolean; override;
    procedure DoExit; override;
    procedure Initialize; override;
    function IsNativeBackground: Boolean; override;
    function IsNativeStyle: Boolean; override;
    function IsTransparent: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure WndProc(var Message: TMessage); override;

    // IcxContainerInnerControl
    function GetControl: TWinControl;
    function GetControlContainer: TcxContainer;

    procedure CheckTransparentBorder;
    property CheckGroup: TcxCustomCheckGroup read GetCheckGroup;
  public
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
  end;

  { TcxCustomCheckGroup }

  TcxCustomCheckGroup = class(TcxCustomButtonGroup)
  private
    FButtonStatesChanging: Boolean;
    FFocusedItemIndex: Integer;
    FStatesItems: Boolean;
    procedure DoButtonChange(Sender: TObject);
    procedure DoButtonEditing(Sender: TObject; var CanEdit: Boolean);
    procedure DoButtonFocusChanged(Sender: TObject);
    function GetActiveProperties: TcxCustomCheckGroupProperties;
    function GetButton(Index: Integer): TcxCheckGroupButton;
    function GetProperties: TcxCustomCheckGroupProperties;
    function GetState(Index: Integer): TcxCheckBoxState;
    procedure SetProperties(Value: TcxCustomCheckGroupProperties);
    procedure SetState(Index: Integer; Value: TcxCheckBoxState);
  protected
    procedure ArrangeButtons; override;
    function GetButtonDC(AButtonIndex: Integer): THandle; override;
    function GetButtonInstance: TWinControl; override;
    procedure Initialize; override;
    procedure InternalSetEditValue(const Value: TcxEditValue; AValidateEditValue: Boolean); override;
    procedure InternalValidateDisplayValue(const ADisplayValue: TcxEditValue); override;
    function IsEditValueStored: Boolean; override;
    procedure ParentBackgroundChanged; override;
    procedure PropertiesChanged(Sender: TObject); override;
    procedure SynchronizeButtonsStyle; override;
    procedure SynchronizeDisplayValue; override;
    procedure SynchronizeModifiedAfterEnter; virtual;
    procedure UpdateButtons; override;
    function WantNavigationKeys: Boolean; override;
    function GetFirstEnabledItemIndex(AStartIndex: Integer): Integer;
    property Buttons[Index: Integer]: TcxCheckGroupButton read GetButton;
    property InternalButtons;
    property StatesItems: Boolean read FStatesItems write FStatesItems stored False;
  public
    procedure Activate(var AEditData: TcxCustomEditData); override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    procedure GetTabOrderList(List: TList); override;
    procedure SetFocus; override;
    property ActiveProperties: TcxCustomCheckGroupProperties
      read GetActiveProperties;
    property Properties: TcxCustomCheckGroupProperties read GetProperties
      write SetProperties;
    property States[Index: Integer]: TcxCheckBoxState read GetState
      write SetState; default;
    property Transparent;
  end;

  { TcxCheckGroup }

  TcxCheckGroup = class(TcxCustomCheckGroup)
  private
    function GetActiveProperties: TcxCheckGroupProperties;
    function GetProperties: TcxCheckGroupProperties;
    procedure SetProperties(Value: TcxCheckGroupProperties);
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxCheckGroupProperties read GetActiveProperties;
  published
    property Align;
    property Alignment;
    property Anchors;
    property Caption;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property EditValue;
    property Enabled;
    property ParentBackground;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxCheckGroupProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property StatesItems;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnFocusChanged;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

  { TcxFilterCheckGroupHelper }

  TcxFilterCheckGroupHelper = class(TcxFilterChecksHelper)
  protected
    class function GetEditValueFormat(
      AEditProperties: TcxCustomEditProperties): TcxCheckStatesValueFormat; override;
    class function GetItems(
      AEditProperties: TcxCustomEditProperties): IcxCheckItems; override;
    class procedure InitializeItems(AProperties,
      AEditProperties: TcxCustomEditProperties); override;
  end;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
  Types,
{$ENDIF}
  SysUtils, cxClasses, cxControls, cxVariants, cxExtEditConsts, cxEditUtils,
  dxThemeManager, cxEditPaintUtils;

{ TcxCheckGroupItems }

function TcxCheckGroupItems.Add: TcxCheckGroupItem;
begin
  Result := TcxCheckGroupItem(inherited Add);
end;

function TcxCheckGroupItems.GetItem(Index: Integer): TcxCheckGroupItem;
begin
  Result := TcxCheckGroupItem(inherited Items[Index]);
end;

procedure TcxCheckGroupItems.SetItem(Index: Integer; Value: TcxCheckGroupItem);
begin
  inherited Items[Index] := Value;
end;

{ TcxCheckGroupButtonViewInfo }

function TcxCheckGroupButtonViewInfo.GetGlyphRect(ACanvas: TcxCanvas;
  AGlyphSize: TSize; AAlignment: TLeftRight; AIsPaintCopy: Boolean): TRect;

  procedure CorrectCheckRect(var ACheckRect: TRect);
  begin
    if AIsPaintCopy then
      if AAlignment = taRightJustify then
        OffsetRect(ACheckRect, 2, 0)
      else
        OffsetRect(ACheckRect, -2, 0);
  end;

begin             
  case AAlignment of
    taLeftJustify: AAlignment := taRightJustify;
    taRightJustify: AAlignment := taLeftJustify;
  end;
  Result := inherited GetGlyphRect(ACanvas, AGlyphSize, AAlignment, AIsPaintCopy);
  CorrectCheckRect(Result);
end;

{ TcxCheckGroupViewInfo }

procedure TcxCheckGroupViewInfo.DrawButtonCaption(ACanvas: TcxCanvas;
  AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect);

  function GetCaptionRect(const ACheckRect: TRect): TRect;
  begin
    Result := AButtonViewInfo.Bounds;
    if Alignment = taLeftJustify then
    begin
      Result.Left := ACheckRect.Right + CaptionExtent.Left;
      Dec(Result.Right, CaptionExtent.Right);
    end
    else
    begin
      Result.Right := ACheckRect.Left - CaptionExtent.Right;
      Inc(Result.Left, CaptionExtent.Left);
    end;
  end;

begin
  DrawCheckBoxText(ACanvas, AButtonViewInfo.Caption, Font, TextColor,
    GetCaptionRect(AGlyphRect), DrawTextFlags, Enabled);
end;

procedure TcxCheckGroupViewInfo.DrawButtonGlyph(ACanvas: TcxCanvas;
  AButtonViewInfo: TcxGroupBoxButtonViewInfo; const AGlyphRect: TRect);
const
  ACheckStateByButtonState: array[TcxEditButtonState] of TcxEditCheckState =

⌨️ 快捷键说明

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