cxlookupgrid.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,076 行 · 第 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 cxLookupGrid;

{$I cxVer.inc}

interface

uses
  Windows,
  SysUtils, Classes, Controls, Graphics, Forms, StdCtrls,
  cxClasses, cxControls, cxContainer, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters,
  cxDataUtils, cxDataStorage, cxCustomData, cxData, cxEdit, cxEditRepositoryItems;

const
  cxLookupGridColumnDefaultMinWidth = 20;
  // TODO: Common
//  cxGridCellTextOffset = 2; // ?
  cxGridEditOffset = 1;

type
  TcxCustomLookupGrid = class;
  TcxLookupGridColumn = class;

  TcxLookupGridHitTest = (htNone, htHeader, htCell);
  TcxLookupGridScrollMode = (smNone, smTop, smBottom);

  { TcxLookupGridDataController }

  TcxLookupGridDataController = class(TcxDataController)
  private
    function GetGrid: TcxCustomLookupGrid;
  public
    function GetItem(Index: Integer): TObject; override;
    property Grid: TcxCustomLookupGrid read GetGrid;
  published
    property OnCompare;
  end;

  { TcxLookupGridViewInfo }

  TcxLookupGridPartViewInfo = class
    Bounds: TRect;
    ContentBounds: TRect;
  end;

  // Columns

  TcxLookupGridColumnViewInfo = class(TcxLookupGridPartViewInfo)
  private
    FEditViewData: TcxCustomEditViewData;
    FStyle: TcxCustomEditStyle;
  public
    Alignment: TAlignment;
    Borders: TcxBorders;
    Neighbors: TcxNeighbors;
    SortOrder: TcxDataSortOrder;
    Text: string;
    destructor Destroy; override;
    function CreateEditStyle(AProperties: TcxCustomEditProperties): TcxCustomEditStyle;
    function CreateEditViewData(AProperties: TcxCustomEditProperties): TcxCustomEditViewData;
    procedure DestroyEditViewData;
    property Style: TcxCustomEditStyle read FStyle;
  end;

  TcxLookupGridColumnsViewInfo = class(TcxObjectList)
  private
    function GetItem(Index: Integer): TcxLookupGridColumnViewInfo;
  public
    property Items[Index: Integer]: TcxLookupGridColumnViewInfo read GetItem; default;
  end;

  // rows

  TcxLookupGridCellViewInfo = class(TcxLookupGridPartViewInfo)
  private
    FEditViewInfo: TcxCustomEditViewInfo;
  public
    Borders: TcxBorders;
    Index: Integer;
    IsFocused: Boolean;
    destructor Destroy; override;
    function CreateEditViewInfo(AProperties: TcxCustomEditProperties): TcxCustomEditViewInfo;
    property EditViewInfo: TcxCustomEditViewInfo read FEditViewInfo;
  end;

  TcxLookupGridRowViewInfo = class(TcxObjectList)
  private
    function GetItem(Index: Integer): TcxLookupGridCellViewInfo;
  protected
    function AddCell(AIndex: Integer; const AInitBounds: TRect; AIsFocused: Boolean): TcxLookupGridCellViewInfo;
  public
    Borders: TcxBorders;
    Bounds: TRect;
    ContentBounds: TRect;
    IsFocused: Boolean;
    RecordIndex: Integer;
    RowIndex: Integer;
    property Items[Index: Integer]: TcxLookupGridCellViewInfo read GetItem; default;
  end;

  TcxLookupGridRowsViewInfo = class(TcxObjectList)
  private
    function GetItem(Index: Integer): TcxLookupGridRowViewInfo;
  public
    function FindByRowIndex(ARowIndex: Integer): TcxLookupGridRowViewInfo;
    property Items[Index: Integer]: TcxLookupGridRowViewInfo read GetItem; default;
  end;

  TcxLookupGridTopRowIndexCalculation = (ticNone, ticForward, ticBackward);

  TcxLookupGridViewInfo = class
  private
    FColumns: TcxLookupGridColumnsViewInfo;
    FGrid: TcxCustomLookupGrid;
    FInternalTopRowIndex: Integer;
    FTopRowIndexCalculation: TcxLookupGridTopRowIndexCalculation;
    FRowMinHeight: Integer;
    FRows: TcxLookupGridRowsViewInfo;
    function GetBounds: TRect;
    function GetCanvas: TcxCanvas;
    function GetClientBounds: TRect;
    function GetEmptyAreaColor: TColor;
    function GetGridLines: TcxGridLines;
    function GetRowCount: Integer;
    function GetRowHeight: Integer;
    function GetTopRowIndex: Integer;
  protected
    function AddRow(ARowIndex: Integer; const AInitBounds: TRect): TcxLookupGridRowViewInfo;
    function CalcCellMinHeight(AIndex: Integer): Integer;
    function CalcRowMinHeight: Integer;
    procedure CalculateCells(ARowViewInfo: TcxLookupGridRowViewInfo);
    function GetCellHeight(ARowIndex, AColumnIndex: Integer): Integer;
    function GetHeaderHeight: Integer; virtual;
    property TopRowIndexCalculation: TcxLookupGridTopRowIndexCalculation read FTopRowIndexCalculation write FTopRowIndexCalculation;
  public
    BorderSize: Integer;
    HeadersRect: TRect;
    EmptyRectBottom, EmptyRectRight: TRect;
    PartialVisibleRowCount, VisibleRowCount: Integer;
    RowsRect: TRect;
    VisibleRowsRect: TRect;
    constructor Create(AGrid: TcxCustomLookupGrid); virtual;
    destructor Destroy; override;
    procedure CalcCellColors(ARowIsSelected, ACellIsSelected: Boolean; var AColor, AFontColor: TColor);
    procedure CalcColumns; virtual;
    procedure CalcEmptyAreas; virtual;
    procedure CalcHeaders; virtual;
    procedure CalcRows; virtual;
    procedure Calculate; virtual;
    function CheckTopRowIndex(ANewTopIndex: Integer): Integer; virtual;
    procedure CreateEditStyle(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); virtual;
    function CreateEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn): TcxCustomEditViewData; virtual;
    procedure DestroyEditViewData(AColumnViewInfo: TcxLookupGridColumnViewInfo; AColumn: TcxLookupGridColumn); virtual;
    function GetContentColor: TColor; virtual;
    function GetContentFont: TFont; virtual;
    function GetContentFontColor: TColor; virtual;
    function GetGridColor: TColor; virtual;
    function GetGridLineWidth: Integer; virtual;
    function GetHeaderColor: TColor; virtual;
    function GetHeaderFont: TFont; virtual;
    function GetHeaderFontColor: TColor; virtual;
    function GetSelectedColor: TColor; virtual;
    function GetSelectedFontColor: TColor; virtual;

    property Bounds: TRect read GetBounds;
    property Canvas: TcxCanvas read GetCanvas;
    property ClientBounds: TRect read GetClientBounds;
    property Columns: TcxLookupGridColumnsViewInfo read FColumns;
    property EmptyAreaColor: TColor read GetEmptyAreaColor;
    property Grid: TcxCustomLookupGrid read FGrid;
    property GridLines: TcxGridLines read GetGridLines;
    property GridLineWidth: Integer read GetGridLineWidth;
    property RowCount: Integer read GetRowCount;
    property RowHeight: Integer read GetRowHeight;
    property Rows: TcxLookupGridRowsViewInfo read FRows;
    property TopRowIndex: Integer read GetTopRowIndex;
  end;

  TcxLookupGridViewInfoClass = class of TcxLookupGridViewInfo;

  { TcxLookupGridPainter }

  TcxLookupGridPainter = class
  private
    FCanvas: TcxCanvas;
    FGrid: TcxCustomLookupGrid;
    FLFPainterClass: TcxCustomLookAndFeelPainterClass;
    function GetCanvas: TcxCanvas;
    function GetViewInfo: TcxLookupGridViewInfo;
  protected
    procedure DrawBorder; virtual;
    procedure DrawCell(ACellViewInfo: TcxLookupGridCellViewInfo); virtual;
    procedure DrawContent; virtual;
    procedure DrawEmptyArea; virtual;
    procedure DrawHeaders; virtual;
    procedure DrawRow(ARowViewInfo: TcxLookupGridRowViewInfo); virtual;
    procedure DrawRows; virtual;
    property ViewInfo: TcxLookupGridViewInfo read GetViewInfo;
  public
    constructor Create(AGrid: TcxCustomLookupGrid); virtual;
    destructor Destroy; override;
    procedure Invalidate;
    procedure Paint;
    property Canvas: TcxCanvas read GetCanvas;
    property Grid: TcxCustomLookupGrid read FGrid;
    property LFPainterClass: TcxCustomLookAndFeelPainterClass read FLFPainterClass write FLFPainterClass;
  end;

  TcxLookupGridPainterClass = class of TcxLookupGridPainter;

  { TcxLookupGridColumn }

  TcxLookupGridDefaultValuesProvider = class(TcxCustomEditDefaultValuesProvider)
    function IsDisplayFormatDefined(AIsCurrencyValueAccepted: Boolean): Boolean; override;
  end;

  TcxLookupGridColumn = class(TCollectionItem, IUnknown,
    IcxEditRepositoryItemListener)
  private
    FCaption: string;
    FDefaultValuesProvider: TcxCustomEditDefaultValuesProvider;
    FHeaderAlignment: TAlignment;
    FInternalDefaultRepositoryItem: TcxEditRepositoryItem;
    FIsCaptionAssigned: Boolean;
    FIsWidthAssigned: Boolean;
    FMinWidth: Integer;
    FFixed: Boolean;
    FSorting: Boolean;
    FRepositoryItem: TcxEditRepositoryItem;
    FWidth: Integer;
    function GetCaption: string;
    function GetDataController: TcxCustomDataController;
    function GetGrid: TcxCustomLookupGrid;
    function GetMinWidth: Integer;
    function GetProperties: TcxCustomEditProperties;
    function GetSortOrder: TcxDataSortOrder;
    function GetWidth: Integer;
    function IsCaptionStored: Boolean;
    function IsWidthStored: Boolean;
    procedure SetCaption(const Value: string);
    procedure SetFixed(Value: Boolean);
    procedure SetHeaderAlignment(Value: TAlignment);
    procedure SetMinWidth(Value: Integer);
    procedure SetRepositoryItem(Value: TcxEditRepositoryItem);
    procedure SetSorting(Value: Boolean);
    procedure SetSortOrder(Value: TcxDataSortOrder);
    procedure SetWidth(Value: Integer);
  protected
    // IUnknown
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    // IcxEditRepositoryItemListener
    procedure ItemRemoved(Sender: TcxEditRepositoryItem);
    procedure PropertiesChanged(Sender: TcxEditRepositoryItem);
    // base
    procedure CheckWidthValue(var Value: Integer); virtual;
    function GetDefaultValuesProviderClass: TcxCustomEditDefaultValuesProviderClass; virtual;
    function GetValueTypeClass: TcxValueTypeClass; virtual;
    procedure SetIndex(Value: Integer); override;
    procedure SetValueTypeClass(Value: TcxValueTypeClass); virtual;
    property DataController: TcxCustomDataController read GetDataController;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultCaption: string; virtual;
    function DefaultRepositoryItem: TcxEditRepositoryItem; virtual;
    function DefaultWidth: Integer; virtual;
    function GetContentFont: TFont; virtual;
    function GetInternalDefaultRepositoryItem: TcxEditRepositoryItem; virtual;
    function GetRepositoryItem: TcxEditRepositoryItem; virtual;
    function IsLeft: Boolean; virtual;
    function IsRight: Boolean; virtual;
    procedure RestoreDefaults; virtual;
    property DefaultValuesProvider: TcxCustomEditDefaultValuesProvider read FDefaultValuesProvider;
    property Properties: TcxCustomEditProperties read GetProperties;
    property Grid: TcxCustomLookupGrid read GetGrid;
    property ValueTypeClass: TcxValueTypeClass read GetValueTypeClass write SetValueTypeClass;
  published
    property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
    property Fixed: Boolean read FFixed write SetFixed default False;
    property HeaderAlignment: TAlignment read FHeaderAlignment write SetHeaderAlignment default taLeftJustify;
    property MinWidth: Integer read GetMinWidth write SetMinWidth default cxLookupGridColumnDefaultMinWidth;
    property Sorting: Boolean read FSorting write SetSorting default True;
    property SortOrder: TcxDataSortOrder read GetSortOrder write SetSortOrder default soNone;
    property RepositoryItem: TcxEditRepositoryItem read FRepositoryItem write SetRepositoryItem;
    property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
  end;

  TcxLookupGridColumnClass = class of TcxLookupGridColumn;

  { TcxLookupGridColumns }

  TcxLookupGridColumns = class(TCollection)
  private
    FGrid: TcxCustomLookupGrid;
    function GetColumn(Index: Integer): TcxLookupGridColumn;
    procedure SetColumn(Index: Integer; Value: TcxLookupGridColumn);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AGrid: TcxCustomLookupGrid; AColumnClass: TcxLookupGridColumnClass); virtual;
    function Add: TcxLookupGridColumn;
    procedure BeginUpdate; override;
    procedure EndUpdate; override;
    procedure RestoreDefaults; virtual;
    property Grid: TcxCustomLookupGrid read FGrid;
    property Items[Index: Integer]: TcxLookupGridColumn read GetColumn write SetColumn; default;
  end;

  TcxLookupGridColumnsClass = class of TcxLookupGridColumns;

  { TcxCustomLookupGrid }

  TcxLookupGridChange = (lgcLayout, lgcData, lgcFocusedRow);
  TcxLookupGridChanges = set of TcxLookupGridChange;

  TcxLookupGridHitInfo = record
    HitTest: TcxLookupGridHitTest;
    RowIndex: Integer;
    ColumnIndex: Integer;
  end;

  TcxLookupGridOptions = class(TPersistent)
  private
    FColumnSorting: Boolean;
    FFocusRowOnMouseMove: Boolean;
    FGridLines: TcxGridLines;
    FRowSelect: Boolean;
    FShowHeader: Boolean;
    FOnChanged: TNotifyEvent;
    function GetAnsiSort: Boolean;
    function GetCaseInsensitive: Boolean;
    procedure SetAnsiSort(Value: Boolean);
    procedure SetCaseInsensitive(Value: Boolean);
    procedure SetGridLines(Value: TcxGridLines);
    procedure SetRowSelect(Value: Boolean);
    procedure SetShowHeader(Value: Boolean);
  protected
    FGrid: TcxCustomLookupGrid;
    procedure Changed; virtual;
  public
    constructor Create(AGrid: TcxCustomLookupGrid); virtual;
    procedure Assign(Source: TPersistent); override;
    property Grid: TcxCustomLookupGrid read FGrid;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  published
    property AnsiSort: Boolean read GetAnsiSort write SetAnsiSort default False;
    property CaseInsensitive: Boolean read GetCaseInsensitive write SetCaseInsensitive default False;
    property ColumnSorting: Boolean read FColumnSorting write FColumnSorting default True;
    property FocusRowOnMouseMove: Boolean read FFocusRowOnMouseMove
      write FFocusRowOnMouseMove default True;
    property GridLines: TcxGridLines read FGridLines write SetGridLines default glBoth;
    property RowSelect: Boolean read FRowSelect write SetRowSelect default True;
    property ShowHeader: Boolean read FShowHeader write SetShowHeader default True;
  end;

  TcxLookupGridOptionsClass = class of TcxLookupGridOptions;

  TcxLookupGridCloseUpEvent = procedure (Sender: TObject; AAccept: Boolean) of object;

  TcxCustomLookupGrid = class(TcxControl)
  private
    FChanges: TcxLookupGridChanges;
    FColumns: TcxLookupGridColumns;
    FFocusedColumn: TcxLookupGridColumn;
    FIsPopupControl: Boolean;
    FLockCount: Integer;
    FPainter: TcxLookupGridPainter;
    FRowPressed: Boolean;
    FScrollMode: TcxLookupGridScrollMode;
    FScrollTimer: TcxTimer;
    FTopRowIndex: Integer;
    FViewInfo: TcxLookupGridViewInfo;
    FOnClick: TNotifyEvent;
    FOnCloseUp: TcxLookupGridCloseUpEvent;
    FOnDataChanged: TNotifyEvent;
    FOnFocusedRowChanged: TNotifyEvent;
    procedure CreateScrollTimer;
    procedure DestroyScrollTimer;