unitasdbgrids.pas

仿速达界面控件

{*******************************************************
仿速达DBGrid制作的DBGrid
By wr960204 王锐

2004/8/8
*******************************************************}
unit UnitASDBGrids;

{$R-}

interface

uses
  ExtCtrls, UnitASUtils,
  Variants, Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  Graphics, UnitASGrids, DBCtrls, Db, Menus, ImgList;

type
  TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly,
    cvTitleColor,
    cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName);
  TColumnValues = set of TColumnValue;

const
  FloatMaxLength    = 18;
  BorderStyles      : array[TBorderStyle] of DWORD = (0, WS_BORDER);
  ColumnTitleValues = [cvTitleColor..cvTitleFont];
  cm_DeferLayout    = WM_USER + 100;
  //Type

type
  TColumn = class;
  TCustomASDBGrid = class;

  TColumnButtonClick = procedure(Sender: TObject; Column: TColumn) of object;

  TColumnTitle = class(TPersistent)
  private
    FColumn: TColumn;
    FLayerCaption: TStrings;
    FCaption: string;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
    procedure FontChanged(Sender: TObject);
    function GetAlignment: TAlignment;
    function GetColor: TColor;
    function GetCaption: string;
    function GetFont: TFont;
    function IsAlignmentStored: Boolean;
    function IsColorStored: Boolean;
    function IsFontStored: Boolean;
    function IsCaptionStored: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetCaption(const Value: string); virtual;
  protected
    procedure RefreshDefaultFont;
  public
    constructor Create(Column: TColumn);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    function DefaultCaption: string;
    procedure RestoreDefaults; virtual;
    property Column: TColumn read FColumn;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment
      stored IsAlignmentStored;
    property Caption: string read GetCaption write SetCaption stored
      IsCaptionStored;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
  end;

  TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);

  TColumn = class(TCollectionItem)
  private
    FField: TField;
    FFieldName: string;
    FColor: TColor;
    FChineseCurrencyStyle: Boolean;
    FWidth: Integer;
    FWidthFixed: Boolean;
    FTitle: TColumnTitle;
    FFont: TFont;
    FImeMode: TImeMode;
    FImeName: TImeName;
    FPickList: TStrings;
    FonButtonClick: TColumnButtonClick;
    FPopupMenu: TPopupMenu;
    FDropDownRows: Cardinal;
    FButtonStyle: TColumnButtonStyle;
    FAlignment: TAlignment;
    FReadonly: Boolean;
    FAssignedValues: TColumnValues;
    FVisible: Boolean;
    FExpanded: Boolean;
    FRowNumber: Boolean;
    FRowNumberFrom: Integer;
    FStored: Boolean;
    FCurrencySymbol: WideChar;
    procedure FontChanged(Sender: TObject);
    function GetAlignment: TAlignment;
    function GetColor: TColor;
    function GetExpanded: Boolean;
    function GetField: TField;
    function GetFont: TFont;
    function GetImeMode: TImeMode;
    function GetImeName: TImeName;
    function GetParentColumn: TColumn;
    function GetPickList: TStrings;
    function GetReadOnly: Boolean;
    function GetShowing: Boolean;
    function GetWidth: Integer;
    function GetVisible: Boolean;
    function IsAlignmentStored: Boolean;
    function IsColorStored: Boolean;
    function IsFontStored: Boolean;
    function IsImeModeStored: Boolean;
    function IsImeNameStored: Boolean;
    function IsReadOnlyStored: Boolean;
    function IsWidthStored: Boolean;
    procedure SetAlignment(Value: TAlignment); virtual;
    procedure SetButtonStyle(Value: TColumnButtonStyle);
    procedure SetColor(Value: TColor);
    procedure SetExpanded(Value: Boolean);
    procedure SetField(Value: TField); virtual;
    procedure SetFieldName(const Value: string);
    procedure SetFont(Value: TFont);
    procedure SetImeMode(Value: TImeMode); virtual;
    procedure SetImeName(Value: TImeName); virtual;
    procedure SetPickList(Value: TStrings);
    procedure SetPopupMenu(Value: TPopupMenu);
    procedure SetReadOnly(Value: Boolean); virtual;
    procedure SetTitle(Value: TColumnTitle);
    procedure SetWidth(Value: Integer); virtual;
    procedure SetVisible(Value: Boolean);
    function GetExpandable: Boolean;
    procedure SetChineseCurrencyStyle(const Value: Boolean);
    function GetCurrencySymbol: WideString;
    procedure SetCurrencySymbol(const Value: WideString);
    procedure SetRowNumber(const Value: Boolean);
    procedure SetRowNumberFrom(const Value: Integer);
    function GetButtonStyle: TColumnButtonStyle;
  protected
    function CreateTitle: TColumnTitle; virtual;
    function GetGrid: TCustomASDBGrid;
    function GetDisplayName: string; override;
    procedure RefreshDefaultFont;
    procedure SetIndex(Value: Integer); override;
    property IsStored: Boolean read FStored write FStored default True;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    function DefaultImeMode: TImeMode;
    function DefaultImeName: TImeName;
    function DefaultReadOnly: Boolean;
    function DefaultWidth: Integer;
    function Depth: Integer;
    procedure RestoreDefaults; virtual;
    property Grid: TCustomASDBGrid read GetGrid;
    property AssignedValues: TColumnValues read FAssignedValues;
    property Expandable: Boolean read GetExpandable;
    property Field: TField read GetField write SetField;
    property ParentColumn: TColumn read GetParentColumn;
    property Showing: Boolean read GetShowing;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment
      stored IsAlignmentStored;
    property ButtonStyle: TColumnButtonStyle read GetButtonStyle write
      SetButtonStyle
      default cbsAuto;
    property OnButtonClick: TColumnButtonClick read FOnButtonClick write
      FOnButtonClick;
    property ChineseCurrencyStyle: Boolean read FChineseCurrencyStyle write
      SetChineseCurrencyStyle;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property CurrencySymbol: WideString read GetCurrencySymbol write
      SetCurrencySymbol;
    property DropDownRows: Cardinal read FDropDownRows write FDropDownRows
      default 7;
    property Expanded: Boolean read GetExpanded write SetExpanded default True;
    property FieldName: string read FFieldName write SetFieldName;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    property ImeMode: TImeMode read GetImeMode write SetImeMode stored
      IsImeModeStored;
    property ImeName: TImeName read GetImeName write SetImeName stored
      IsImeNameStored;
    property PickList: TStrings read GetPickList write SetPickList;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly
      stored IsReadOnlyStored;
    property RowNumber: Boolean read FRowNumber write SetRowNumber;
    property RowNumberFrom: Integer read FRowNumberFrom write SetRowNumberFrom;
    property Title: TColumnTitle read FTitle write SetTitle;
    property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    property WidthFixed: Boolean read FWidthFixed write FWidthFixed;
    property Visible: Boolean read GetVisible write SetVisible;
  end;

  TColumnClass = class of TColumn;

  TASDBGridColumnsState = (csDefault, csCustomized);

  TASDBGridColumns = class(TCollection)
  private
    FGrid: TCustomASDBGrid;
    function GetColumn(Index: Integer): TColumn;
    function InternalAdd: TColumn;
    procedure SetColumn(Index: Integer; Value: TColumn);
    procedure SetState(NewState: TASDBGridColumnsState);
    function GetState: TASDBGridColumnsState;
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Grid: TCustomASDBGrid; ColumnClass: TColumnClass);
    function Add: TColumn;
    procedure LoadFromFile(const Filename: string);
    procedure LoadFromStream(S: TStream);
    procedure RestoreDefaults;
    procedure RebuildColumns;
    procedure SaveToFile(const Filename: string);
    procedure SaveToStream(S: TStream);
    property State: TASDBGridColumnsState read GetState write SetState;
    property Grid: TCustomASDBGrid read FGrid;
    property Items[Index: Integer]: TColumn read GetColumn write SetColumn;
    default;
  end;

  TGridDataLink = class(TDataLink)
  private
    FGrid: TCustomASDBGrid;
    FFieldCount: Integer;
    FFieldMap: array of Integer;
    FModified: Boolean;
    FInUpdateData: Boolean;
    FSparseMap: Boolean;
    function GetDefaultFields: Boolean;
    function GetFields(I: Integer): TField;
  protected
    procedure ActiveChanged; override;
    procedure BuildAggMap;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure EditingChanged; override;
    function IsAggRow(Value: Integer): Boolean; virtual;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
    function GetMappedIndex(ColIndex: Integer): Integer;
  public
    constructor Create(AGrid: TCustomASDBGrid);
    destructor Destroy; override;
    function AddMapping(const FieldName: string): Boolean;
    procedure ClearMapping;
    procedure Modified;
    procedure Reset;
    property DefaultFields: Boolean read GetDefaultFields;
    property FieldCount: Integer read FFieldCount;
    property Fields[I: Integer]: TField read GetFields;
    property SparseMap: Boolean read FSparseMap write FSparseMap;
    property Grid: TCustomASDBGrid read FGrid;
  end;

  TBookmarkList = class
  private
    FList: TStringList;
    FGrid: TCustomASDBGrid;
    FCache: TBookmarkStr;
    FCacheIndex: Integer;
    FCacheFind: Boolean;
    FLinkActive: Boolean;
    function GetCount: Integer;
    function GetCurrentRowSelected: Boolean;
    function GetItem(Index: Integer): TBookmarkStr;
    procedure SetCurrentRowSelected(Value: Boolean);
    procedure StringsChanged(Sender: TObject);
  protected
    function CurrentRow: TBookmarkStr;
    function Compare(const Item1, Item2: TBookmarkStr): Integer;
    procedure LinkActive(Value: Boolean);
  public
    constructor Create(AGrid: TCustomASDBGrid);
    destructor Destroy; override;
    procedure Clear;                    // free all bookmarks
    procedure Delete;                   // delete all selected rows from dataset
    function Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
    function IndexOf(const Item: TBookmarkStr): Integer;
    function Refresh: Boolean; // drop orphaned bookmarks; True = orphans found
    property Count: Integer read GetCount;
    property CurrentRowSelected: Boolean read GetCurrentRowSelected
      write SetCurrentRowSelected;
    property Items[Index: Integer]: TBookmarkStr read GetItem; default;
  end;

  TASDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect);
  TASDBGridOptions = set of TASDBGridOption;

  { The DBGrid's DrawDataCell virtual method and OnDrawDataCell event are only
    called when the grid's Columns.State is csDefault.  This is for compatibility
    with existing code. These routines don't provide sufficient information to
    determine which column is being drawn, so the column attributes aren't
    easily accessible in these routines.  Column attributes also introduce the
    possibility that a column's field may be nil, which would break existing
    DrawDataCell code.   DrawDataCell, OnDrawDataCell, and DefaultDrawDataCell
    are obsolete, retained for compatibility purposes. }
  TDrawDataCellEvent = procedure(Sender: TObject; const Rect: TRect; Field:
    TField;
    State: TGridDrawState) of object;

  { The DBGrid's DrawColumnCell virtual method and OnDrawColumnCell event are
    always called, when the grid has defined column attributes as well as when
    it is in default mode.  These new routines provide the additional
    information needed to access the column attributes for the cell being
    drawn, and must support nil fields.  }

  TDrawColumnCellEvent = procedure(Sender: TObject; const Rect: TRect;
    DataCol: Integer; Column: TColumn; State: TGridDrawState) of object;
  TASDBGridClickEvent = procedure(Column: TColumn) of object;

  TCustomASDBGrid = class(TCustomASGrid)
  private
    FFixed3D: Boolean;
    FIndicators: TImageList;
    FTitleFont: TFont;
    FReadOnly: Boolean;
    FOriginalImeName: TImeName;
    FOriginalImeMode: TImeMode;
    FUserChange: Boolean;
    FIsESCKey: Boolean;
    FMultiTitile: Boolean;
    FLayoutFromDataset: Boolean;
    FOptions: TASDBGridOptions;
    FTitleOffset, FIndicatorOffset: Byte;
    FUpdateLock: Byte;
    FLayoutLock: Byte;
    FInColExit: Boolean;
    FDefaultDrawing: Boolean;
    FSelfChangingTitleFont: Boolean;
    FSelecting: Boolean;
    FSelRow: Integer;
    FDataLink: TGridDataLink;
    FOnColEnter: TNotifyEvent;
    FOnColExit: TNotifyEvent;
    FOnDrawDataCell: TDrawDataCellEvent;
    FOnDrawColumnCell: TDrawColumnCellEvent;
    FEditText: string;
    FColumns: TASDBGridColumns;
    FVisibleColumns: TList;
    FBookmarks: TBookmarkList;
    FSelectionAnchor: TBookmarkStr;
    FOnEditButtonClick: TColumnButtonClick;
    FOnColumnMoved: TMovedEvent;
    FOnCellClick: TASDBGridClickEvent;
    FOnTitleClick: TASDBGridClickEvent;
    FDragCol: TColumn;
    function AcquireFocus: Boolean;
    procedure DataChanged;
    procedure EditingChanged;
    function GetDataSource: TDataSource;
    function GetFieldCount: Integer;
    function GetFields(FieldIndex: Integer): TField;
    function GetSelectedField: TField;
    function GetSelectedIndex: Integer;
    procedure InternalLayout;
    procedure MoveCol(RawCol, Direction: Integer);
    function PtInExpandButton(X, Y: Integer; var MasterCol: TColumn): Boolean;
    procedure ReadColumns(Reader: TReader);
    procedure RecordChanged(Field: TField);
    procedure SetIme;
    procedure SetColumns(Value: TASDBGridColumns);
    procedure SetDataSource(Value: TDataSource);
    procedure SetOptions(Value: TASDBGridOptions);
    procedure SetSelectedField(Value: TField);
    procedure SetSelectedIndex(Value: Integer);
    procedure SetTitleFont(Value: TFont);
    procedure TitleFontChanged(Sender: TObject);
    //procedure UpdateEdit; override;
    procedure UpdateData;
    procedure UpdateActive;
    procedure UpdateIme;
    procedure UpdateScrollBar;
    procedure UpdateRowCount;
    procedure WriteColumns(Writer: TWriter);
    procedure CMBiDiModeChanged(var Message: TMessage); message
      CM_BIDIMODECHANGED;
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message
      CM_PARENTFONTCHANGED;
    procedure CMDeferLayout(var Message); message cm_DeferLayout;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message
      CM_DESIGNHITTEST;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMIMEStartComp(var Message: TMessage); message
      WM_IME_STARTCOMPOSITION;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFOCUS;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    procedure SetFixed3D(const Value: Boolean);
    procedure SetMultiTitile(const Value: Boolean);
  protected

    FUpdateFields: Boolean;
    FAcquireFocus: Boolean;
    function RawToDataColumn(ACol: Integer): Integer;
    function DataToRawColumn(ACol: Integer): Integer;
    function AcquireLayoutLock: Boolean;
    procedure BeginLayout;
    procedure BeginUpdate;
    procedure CalcSizingState(X, Y: Integer; var State: TGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TGridDrawInfo); override;
    procedure CancelLayout;
    function CanEditAcceptKey(Key: Char): Boolean; override;
    function CanEditModify: Boolean; override;
    function CanEditShow: Boolean; override;
    procedure CellClick(Column: TColumn); dynamic;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    function CalcTitleRect(Col: TColumn; ARow: Integer;
      var MasterCol: TColumn): TRect;
    function CalcMultiTitleRect(Col: TColumn; ARow: Integer;
      var MasterCol: TColumn; ALayer: Integer): TRect;
    function ColumnAtDepth(Col: TColumn; ADepth: Integer): TColumn;
    procedure ColEnter; dynamic;
    procedure ColExit; dynamic;
    procedure ColWidthsChanged; override;
    function CreateColumns: TASDBGridColumns; dynamic;
    function CreateEditor: TInplaceEdit; override;
    function CreateDataLink: TGridDataLink; dynamic;
    procedure CreateWnd; override;
    procedure DeferLayout;
    procedure DefineFieldMap; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState:
      TGridDrawState); override;
    procedure DrawDataCell(const Rect: TRect; Field: TField;
      State: TGridDrawState); dynamic;  { obsolete }
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); dynamic;
    procedure EditButtonClick; dynamic;
    procedure EndLayout;
    procedure EndUpdate;
    function GetColField(DataCol: Integer): TField;
    function GetEditLimit: Integer; override;
    function GetEditMask(ACol, ARow: Longint): string; override;
    function GetEditStyle(ACol, ARow: Longint): TEditStyle; override;
    function GetEditText(ACol, ARow: Longint): string; override;
    function GetFieldValue(ACol: Integer): string;
    function HighlightCell(DataCol, DataRow: Integer; const Value: string;
      AState: TGridDrawState): Boolean; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure InvalidateTitles;
    procedure LayoutChanged; virtual;