cxchecklistbox.pas

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

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

interface

{$I cxVer.inc}

uses
  Windows, Messages,
{$IFDEF DELPHI6}
  Types, Variants,
{$ENDIF}
  SysUtils, Classes, Controls, Graphics, StdCtrls, Forms, Math, cxClasses,
  cxControls, cxContainer, cxListBox, cxCheckBox, cxEdit, cxGraphics,
  cxExtEditConsts, cxExtEditUtils, cxVariants, cxDataUtils, cxScrollBar,
  cxLookAndFeels, ImgList, cxLookAndFeelPainters;

type
  TcxCustomCheckListBox = class;
  TcxCustomInnerCheckListBox = class;

  TcxCheckListBoxImageLayout = (ilBeforeChecks, ilAfterChecks);

  TcxClickCheckEvent = procedure(Sender: TObject; AIndex: Integer;
    APrevState, ANewState: TcxCheckBoxState) of object;

  TcxCheckStatesToEditValueEvent = procedure(Sender: TObject;
    const ACheckStates: TcxCheckStates; out AEditValue: TcxEditValue) of object;
  TcxEditValueToCheckStatesEvent = procedure(Sender: TObject;
    const AEditValue: TcxEditValue; var ACheckStates: TcxCheckStates) of object;

  { TcxCheckListBoxItem }

  TcxCheckListBoxItem = class(TCollectionItem)
  private
    FEnabled: Boolean;
    FImageIndex: TImageIndex;
    FItemObject: TObject;
    FState: TcxCheckBoxState;
    FTag: TcxTag;
    FText: TCaption;
    function GetChecked: Boolean;
    function IsTagStored: Boolean;
    procedure SetText(const Value: TCaption);
    procedure SetEnabled(Value: Boolean);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetState(Value: TcxCheckBoxState);
    procedure SetChecked(Value: Boolean);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    property Checked: Boolean read GetChecked write SetChecked;
    property ItemObject: TObject read FItemObject write FItemObject;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property State: TcxCheckBoxState read FState write SetState default cbsUnchecked;
    property Tag: TcxTag read FTag write FTag stored IsTagStored;
    property Text: TCaption read FText write SetText;
  end;

  { TcxCheckListBoxItems }

  TcxCheckListBoxItems = class(TOwnedCollection, IUnknown,
    IcxCheckItems)
  private
    FChangedLockCount: Integer;
    FCheckListBox: TcxCustomInnerCheckListBox;
    function GetItems(Index: Integer): TcxCheckListBoxItem;
    function GetObjects(Index: Integer): TObject;
    procedure SetItems(Index: Integer; const Value: TcxCheckListBoxItem);
    procedure SetObjects(Index: Integer; Value: TObject);

    //  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;
    function IsChangedLocked: Boolean;
    procedure LockChanged(ALock: Boolean; AInvokeChangedOnUnlock: Boolean = True);
  public
    constructor Create(AOwner: TcxCustomInnerCheckListBox;
      ItemClass: TCollectionItemClass);
    destructor Destroy; override;
    property CheckListBox: TcxCustomInnerCheckListBox read FCheckListBox;
    property Items[Index: Integer]: TcxCheckListBoxItem read GetItems write SetItems; default;
    function Add: TcxCheckListBoxItem;
    procedure Delete(Index: Integer);
    function IndexOf(const S: TCaption): Integer;
    function IndexOfObject(AObject: TObject): Integer;
    procedure LoadStrings(AStrings: TStrings);
    property Objects[Index: Integer]: TObject read GetObjects write SetObjects;
  end;

  { TcxCustomInnerCheckListBox }

  TcxCheckListBoxMetrics = record
    CheckFrameWidth: Integer;
    ContentOffset: Integer;
    ImageFrameWidth: Integer;
    TextAreaOffset: Integer;
    TextOffset: Integer;
    TextWidthCorrection: Integer;
  end;

  TcxCustomInnerCheckListBox = class(TcxCustomInnerListBox,
    IUnknown, IcxMouseTrackingCaller)
  private
    FAllowGrayed: Boolean;
    FAllowDblClickToggle: Boolean;
    FCapturedCheckIndex: Integer;
    FCheckItems: TcxCheckListBoxItems;
    FGlyph: TBitmap;
    FGlyphCount: Integer;
    FHotCheckIndex: Integer;
    FMetrics: TcxCheckListBoxMetrics;
    FNewPressedCheckIndex: Integer;
    FNewPressedCheckItemFullyVisible: Boolean;
    FPressedCheckIndex: Integer;
    FOnClickCheck: TcxClickCheckEvent;
    function GetContainer: TcxCustomCheckListBox;
    procedure DrawCheck(R: TRect; AState: TcxCheckBoxState;
      ACheckState: TcxEditCheckState);
    function GetGlyph: TBitmap;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGlyphCount(Value: Integer);
    procedure ToggleClickCheck(Index: Integer);
    procedure InvalidateCheck(Index: Integer);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    // IcxMouseTrackingCaller
    procedure IcxMouseTrackingCaller.MouseLeave = MouseTrackingMouseLeave;
    procedure MouseTrackingMouseLeave;

    procedure AdjustItemHeight;
    procedure CheckHotTrack;
    procedure Click; override;
    function GetCheckAt(X, Y: Integer): Integer;
    procedure GetCheckMetrics(out ACheckSize: TSize;
      out ACheckBorderOffset: Integer);
    function GetCheckRect(const R: TRect; AReturnFullRect: Boolean): TRect;
    function GetCheckRegionWidth: Integer; virtual;
    function GetMetrics: TcxCheckListBoxMetrics; virtual;
    function GetStandardItemHeight: Integer; virtual;
    procedure InternalMouseMove(Shift: TShiftState; X, Y: Integer);
    procedure FullRepaint; virtual;
    procedure InvalidateItem(Index: Integer); virtual;
    procedure SynchronizeCheckStates(ANewHotCheckIndex, ANewPressedCheckIndex: Integer);
    procedure UpdateCheckStates;
    procedure UpdateEditValue;
    procedure WndProc(var Message: TMessage); override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure DoClickCheck(const AIndex: Integer;
      const OldState, NewState: TcxCheckBoxState); virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DblClick; override;
    property AllowDblClickToggle: Boolean read FAllowDblClickToggle
      write FAllowDblClickToggle default True;
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
    property CheckItems: TcxCheckListBoxItems read FCheckItems write FCheckItems;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphCount: Integer read FGlyphCount write SetGlyphCount default 6;
    property Metrics: TcxCheckListBoxMetrics read FMetrics;
    property OnClickCheck: TcxClickCheckEvent read FOnClickCheck write FOnClickCheck;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    property Container: TcxCustomCheckListBox read GetContainer;
  published
    { Published declarations }
  end;

  TcxCustomInnerCheckListBoxClass = class of TcxCustomInnerCheckListBox;
  
  { TcxCustomCheckListBox }

  TcxCustomCheckListBox = class(TcxContainer)
  private
    FCheckBorderStyle: TcxEditCheckBoxBorderStyle;
    FEditValue: TcxEditValue;
    FEditValueFormat: TcxCheckStatesValueFormat;
    FImages: TCustomImageList;
    FImagesChangeLink: TChangeLink;
    FImageLayout: TcxCheckListBoxImageLayout;
    FInnerCheckListBox: TcxCustomInnerCheckListBox;
    FIntegralHeight: Boolean;
    FIsExitProcessing: Boolean;
    FIsModified: Boolean;
    FItemTextList: TStringList;
    FListStyle: TListBoxStyle;
    FNativeStyle: Boolean;
    FShowChecks: Boolean;
    FSorted: Boolean;
    FOnCheckStatesToEditValue: TcxCheckStatesToEditValueEvent;
    FOnDrawItem: TDrawItemEvent;
    FOnEditValueChanged: TNotifyEvent;
    FOnEditValueToCheckStates: TcxEditValueToCheckStatesEvent;
    FOnMeasureItem: TMeasureItemEvent;
    function GetOnClickCheck: TcxClickCheckEvent;
    function GetAllowGrayed: Boolean;
    function GetAllowDblClickToggle: Boolean;
    function GetAutoComplete: Boolean;
    function GetAutoCompleteDelay: Cardinal;
    function GetGlyph: TBitmap;
    function GetGlyphCount: Integer;
    function GetItemHeight: Integer;
    function GetItems: TcxCheckListBoxItems;
    function GetColumns: Integer;
    function GetCount: Integer;
    function GetItemIndex: Integer;
    function GetScrollWidth: Integer;
    function GetSelected(Index: Integer): Boolean;
    function GetTabWidth: Integer;
    function GetTopIndex: Integer;
    procedure ImagesChanged(Sender: TObject);
    function IsItemHeightStored: Boolean;
    procedure SetOnClickCheck(Value: TcxClickCheckEvent);
    procedure SetAllowGrayed(Value: Boolean);
    procedure SetAllowDblClickToggle(Value: Boolean);
    procedure SetAutoComplete(Value: Boolean);
    procedure SetAutoCompleteDelay(Value: Cardinal);
    procedure SetDataBinding(Value: TcxCustomDataBinding);
    procedure SetEditValueFormat(Value: TcxCheckStatesValueFormat);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGlyphCount(Value: Integer);
    procedure SetItemHeight(Value: Integer);
    procedure SetItems(Value: TcxCheckListBoxItems);
    procedure SetColumns(Value: Integer);
    procedure SetImageLayout(Value: TcxCheckListBoxImageLayout);
    procedure SetIntegralHeight(Value: Boolean);
    procedure SetItemIndex(Value: Integer);
    procedure SetListStyle(Value: TListBoxStyle);
    procedure SetImages(Value: TCustomImageList);
    procedure SetScrollWidth(Value: Integer);
    procedure SetSelected(Index: Integer; Value: Boolean);
    procedure SetShowChecks(Value: Boolean);
    procedure SetSorted(Value: Boolean);
    procedure SetTabWidth(Value: Integer);
    procedure SetTopIndex(Value: Integer);
{$IFDEF DELPHI6}
    procedure SetCount(Value: Integer);
{$ENDIF}
    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);
  protected
    FDataBinding: TcxCustomDataBinding;
    procedure CalculateDrawCheckParams;
    procedure DoExit; override;
    function IsReadOnly: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure FontChanged; override;
    procedure GetOptimalHeight(var ANewHeight: Integer);
    function IsInternalControl(AControl: TControl): Boolean; override;
    procedure SetSize; override;

    class function GetDataBindingClass: TcxCustomDataBindingClass; virtual;
    procedure DataChange; override;
    procedure UpdateData; override;
    procedure WndProc(var Message: TMessage); override;
    procedure DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure DoEditValueChanged; virtual;
    function GetInnerCheckListBoxClass: TcxCustomInnerCheckListBoxClass; virtual;
    procedure SetEditValue(const Value: TcxEditValue); virtual;
    function IsValueValid(const AValue: TcxEditValue;
      AAllowEmpty: Boolean): Boolean; virtual;
    property AllowDblClickToggle: Boolean read GetAllowDblClickToggle
      write SetAllowDblClickToggle default True;
    property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed default False;
    property AutoComplete: Boolean read GetAutoComplete write SetAutoComplete
      default True;
    property AutoCompleteDelay: Cardinal read GetAutoCompleteDelay
      write SetAutoCompleteDelay default cxDefaultAutoCompleteDelay;
    property Columns: Integer read GetColumns write SetColumns default 0;
    property DataBinding: TcxCustomDataBinding read FDataBinding write SetDataBinding;
    property EditValue: TcxEditValue read FEditValue write SetEditValue
      stored False;
    property EditValueFormat: TcxCheckStatesValueFormat read FEditValueFormat
      write SetEditValueFormat default cvfInteger;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphCount: Integer read GetGlyphCount write SetGlyphCount default 6;
    property ImageLayout: TcxCheckListBoxImageLayout read FImageLayout
      write SetImageLayout default ilBeforeChecks;
    property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight
       default False;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight
      stored IsItemHeightStored;
    property ListStyle: TListBoxStyle read FListStyle write SetListStyle
      default lbStandard;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth
      default 0;
    property ShowChecks: Boolean read FShowChecks write SetShowChecks
      default True;
    property Sorted: Boolean read FSorted write SetSorted default False;
    property TabWidth: Integer read GetTabWidth write SetTabWidth default 0;
    property OnCheckStatesToEditValue: TcxCheckStatesToEditValueEvent
      read FOnCheckStatesToEditValue write FOnCheckStatesToEditValue;
    property OnClickCheck: TcxClickCheckEvent read GetOnClickCheck write SetOnClickCheck;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnEditValueChanged: TNotifyEvent read FOnEditValueChanged
      write FOnEditValueChanged;
    property OnEditValueToCheckStates: TcxEditValueToCheckStatesEvent
      read FOnEditValueToCheckStates write FOnEditValueToCheckStates;
    property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function CheckAtPos(const APos: TPoint): Integer;
    procedure Clear;
    function GetBestFitWidth: Integer;
    function GetHeight(ARowCount: Integer): Integer; virtual;
    function GetItemWidth(AIndex: Integer): Integer; virtual;
    function ItemAtPos(const APos: TPoint; AExisting: Boolean): Integer;
    function ItemRect(Index: Integer): TRect;
    procedure Sort;
{$IFDEF DELPHI6}
    procedure AddItem(AItem: string);
    procedure CopySelection(ADestination: TcxCustomCheckListBox);
    procedure DeleteSelected;
    procedure MoveSelection(ADestination: TcxCustomCheckListBox);
{$ENDIF}
    property InnerCheckListBox: TcxCustomInnerCheckListBox read FInnerCheckListBox write FInnerCheckListBox;
    { cxListBox properties }
    property Count: Integer read GetCount{$IFDEF DELPHI6} write SetCount{$ENDIF};
    property IsModified: Boolean read FIsModified write FIsModified;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
    property TopIndex: Integer read GetTopIndex write SetTopIndex;
// !!!
    property Images: TCustomImageList read FImages write SetImages;
    property Items: TcxCheckListBoxItems read GetItems write SetItems;
    property LookAndFeel;
  end;

  { TcxCheckListBox }

  TcxCheckListBox = class(TcxCustomCheckListBox)
  published
    property Align;
    property AllowDblClickToggle;
    property AllowGrayed;
    property Anchors;
    property AutoComplete;
    property AutoCompleteDelay;
    property BiDiMode;
    property Columns;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property EditValue;
    property EditValueFormat;