cmoneydbgrids.~pas

Delphi功能强的DBGRID构件,支持钱币网格,从DBGRIDEH中继承.比速达的网格构件功能更强大.

    //Raymond 2002-07-20 Added
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;

    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure SetWordWrap(const Value: Boolean);
    procedure SetGrid(AGrid: TCChinaCustomDbGrid);
    procedure InternalMove(const Loc: TRect; Redraw: Boolean);
    procedure Hide;
    procedure Move(const Loc: TRect);
    procedure UpdateLoc(const Loc: TRect);
    procedure Invalidate;
    function Visible: Boolean;
  protected
    procedure BoundsChanged; override;
    procedure CloseUp(Accept: Boolean);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure DropDown; virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); 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;
    procedure PaintWindow(DC: HDC); override;
    procedure UpdateContents; override;
    procedure WndProc(var Message: TMessage); override;
    procedure KeyPress(var Key: Char); override;
    property WordWrap: Boolean read FWordWrap write SetWordWrap;
    property EditStyle: TCSEditStyle read FEditStyle write SetEditStyle;
    property ActiveList: TWinControl read FActiveList write FActiveList;
    property DataList: TDBLookupListBox read FDataList;
    property PickList: TCSPopupListBox read FPickList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;


  TCMoneyDBGridScrollBar = class(TPersistent)
  private
    FCMoneyDBGrid: TCChinaCustomDbGrid;
    FKind: TScrollBarKind;
    FVisible: Boolean;
    FTracking: Boolean;
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(AGrid: TCChinaCustomDbGrid; AKind: TScrollBarKind);
    procedure Assign(Source: TPersistent); override;
    function IsScrollBarVisible: Boolean;
    property Kind: TScrollBarKind read FKind;
  published
    property Tracking: Boolean read FTracking write FTracking default False;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;


  TCMoneyDBGridOption = (dghFixed3D, dghFrozen3D, dghFooter3D, dghData3D, dghResizeWholeRightPart,
    dghHighlightFocus, dghClearSelection, dghFitRowHeightToText, dghAutoSortMarking,
    dghMultiSortMarking, dghColumnDrag, dghRowSizing, dghDrawMemoText, dghDrawGraphic,
    dghDichromatic, dghFullDraw);
  TCMoneyDBGridOptions = set of TCMoneyDBGridOption;

  TCMoneyDBGridSelectionType = (gstNon, gstRecordBookmarks, gstRectangle, gstColumns, gstAll);

  TDBCell = record
    Col: Longint;
    Row: TBookmarkStr;
  end;


  TCMoneyDBGridSelectionRect = class(TObject)
  private
    FGrid: TCChinaCustomDbGrid;
    FAnchor: TDBCell;
    FShiftCell: TDBCell;
    function CheckState: Boolean;
    function GetBottomRow: TBookmarkStr;
    function GetLeftCol: Longint;
    function GetRightCol: Longint;
    function GetTopRow: TBookmarkStr;
    function BoxRect(ALeft: Longint; ATop: TBookmarkStr; ARight: Longint; ABottom: TBookmarkStr): TRect;
  public
    constructor Create(AGrid: TCChinaCustomDbGrid);
    procedure Clear;
    procedure Select(ACol: Longint; ARow: TBookmarkStr; AddSel: Boolean);
    function DataCellSelected(DataCol: Longint; DataRow: TBookmarkStr): Boolean;
    property LeftCol: Longint read GetLeftCol;
    property RightCol: Longint read GetRightCol;
    property TopRow: TBookmarkStr read GetTopRow;
    property BottomRow: TBookmarkStr read GetBottomRow;
  end;


  TCMoneyDBGridSelectionCols = class(TCSColumnsList)
  private
    FGrid: TCChinaCustomDbGrid;
    FAnchor: TCSColumn;
    FShiftCol: TCSColumn;
    procedure Add(ACol: TCSColumn);
  public
    constructor Create(AGrid: TCChinaCustomDbGrid);
    procedure InvertSelect(ACol: TCSColumn);
    procedure Select(ACol: TCSColumn; AddSel: Boolean);
    procedure SelectShift(ACol: TCSColumn; Clear: Boolean);
    procedure Clear; override;
    procedure Refresh;
  end;


  TCMoneyDBGridSelection = class
  private
    FGrid: TCChinaCustomDbGrid;
    FRect: TCMoneyDBGridSelectionRect;
    FColumns: TCMoneyDBGridSelectionCols;
    FSelectionType: TCMoneyDBGridSelectionType;
    function GetRows: TCSBookmarkList;
    procedure LinkActive(Value: Boolean);
    procedure SetSelectionType(ASelType: TCMoneyDBGridSelectionType);
  public
    constructor Create(AGrid: TCChinaCustomDbGrid);
    destructor Destroy; override;
    function DataCellSelected(DataCol: Longint; DataRow: TBookmarkStr): Boolean;
    procedure Clear;
    procedure SelectAll;
    procedure Refresh;
    procedure UpdateState;
    property Columns: TCMoneyDBGridSelectionCols read FColumns;
    property SelectionType: TCMoneyDBGridSelectionType read FSelectionType;
    property Rect: TCMoneyDBGridSelectionRect read FRect;
    property Rows: TCSBookmarkList read GetRows;
  end;


  { TCSToolTipsWindow 显示不完整的文字的HintWindow }

  TCSToolTipsWindow = class(THintWindow)
  public
    function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  end;


  TCSCheckGlyphs = class(TPersistent)
  private
    FGrid: TCChinaCustomDbGrid;
    FChecked: TBitmap;
    FUnchecked: TBitmap;
    FGray: TBitmap;
  protected
    procedure SetChecked(Value: TBitmap);
    procedure SetUnchecked(Value: TBitmap);
    procedure SetGray(Value: TBitmap);
  public
    constructor Create(AGrid: TCChinaCustomDbGrid);
    destructor Destroy; override;
  published
    property Checked: TBitmap read FChecked write SetChecked;
    property Unchecked: TBitmap read FUnchecked write SetUnchecked;
    property Gray: TBitmap read FGray write SetGray;
  end;


  { TCChinaCustomDbGrid 数据网格基类 }

  TCMoneyDBGridState = (dgsNormal, dgsRowSelecting, dgsColSelecting, dgsRectSelecting,
    dgsPosTracing, dgsTitleDown, dgsColSizing);

  TCMoneyDBGridAllowedOperation = (alopInsert, alopUpdate, alopDelete, alopAppend);
  TCMoneyDBGridAllowedOperations = set of TCMoneyDBGridAllowedOperation;

  TCSDrawColumnCellEvent = procedure(Sender: TObject; const Rect: TRect;
    DataCol: Integer; Column: TCSColumn; State: TGridDrawState) of object;
  TCMoneyDBGridClickEvent = procedure(Column: TCSColumn) of object;
  TCSDrawFooterCellEvent = procedure(Sender: TObject; DataCol, Row: Longint;
    Column: TCSColumn; Rect: TRect; State: TGridDrawState) of object;
  TCSGetFooterParamsEvent = procedure(Sender: TObject; DataCol, Row: Longint;
    Column: TCSColumn; AFont: TFont; var Background: TColor;
    var Alignment: TAlignment; State: TGridDrawState; var Text: string) of object;

  TCSTitleBtnClickEvent = procedure(Sender: TObject; ACol: Longint;
    Column: TCSColumn) of object;
  TCSCheckTitleBtnEvent = procedure(Sender: TObject; ACol: Longint;
    Column: TCSColumn; var Enabled: Boolean) of object;
  TCSGetBtnParamsEvent = procedure(Sender: TObject; Column: TCSColumn;
    AFont: TFont; var Background: TColor; var SortMarker: TCSSortMarker;
    IsDown: Boolean) of object;
  TCSGetCellParamsEvent = procedure(Sender: TObject; Column: TCSColumn;
    AFont: TFont; var Background: TColor; var ReadOnly: Boolean; State: TGridDrawState) of object;
  TCSCalcFieldInputEvent = procedure(Sender: TObject; Field: TField;
    var CanInput: Boolean) of object;  //计算字段是否能够直接输入
  TCSCalcFieldAfterInputEvent = procedure(Sender: TObject; Field: TField; Text: string) of object;  //计算字段输入后的编辑值
  TCSEnterToTabEvent = procedure(var WantTab: Boolean) of object;
  TCSCellEditingEvent = procedure(AColumn: TCSColumn; ACellRect: TRect) of object;
  TCSEditButtonClickEvent = procedure (Sender: TObject; ACol: LongInt; AColumn: TCSColumn) of object;
  TCSGetIndicatorParamsEvent = procedure (Sender: TObject; ARow: LongInt; Rect: TRect; var Image: TPicture) of object;

  TCChinaCustomDbGrid = class(TCustomGrid)
  private
    FInplaceEdit: TCSInplaceEdit; //编辑器
    FOnEnterToTab: TCSEnterToTabEvent;  //键盘操作时是否按回车键跳到下一个单元格
    FOnCellEditing: TCSCellEditingEvent;  //单元格进入编辑状态
    FOnCalcFieldInput: TCSCalcFieldInputEvent;  //确定计算字段数值是否可以输入
    FOnCalcFieldAfterInput: TCSCalcFieldAfterInputEvent;  //计算字段数值输入后提供编辑的数值
    FEditButtonShortCut: TShortCut;  //键盘操作时控制编辑按钮点击的快捷键
    FRowSingleColor: TColor;  //单行颜色
    FRowDoubleColor: TColor;  //双行颜色
    FShowCalcRow: Boolean;  //是否显示合计栏
    FRedWord: Boolean;  //数值型字段值是否在负数时字体显示为红色
    FCheckGlyphs: TCSCheckGlyphs;
    FNextRowClickAppend: Boolean;  //点击空白数据行时是否增加新纪录
    FOnGetIndicatorParams: TCSGetIndicatorParamsEvent;  //更改导航条的图像
    FOnSelectCell: TSelectCellEvent;
    FOnIndicatorClick: TNotifyEvent;  //导航条点击事件
    FIndicatorBarWidth: Integer;  //导航条的宽度
    FRowHighlight: Boolean;  //Raymond 2002-07-22 是否选择的行整行都高亮度显示

    FIndicators: TImageList;
    FTitleFont: TFont;
    FReadOnly: Boolean;
    FOriginalImeName: TImeName;
    FOriginalImeMode: TImeMode;
    FUserChange: Boolean;
    FLayoutFromDataset: Boolean;
    FOptions: TDBGridOptions;
    FTitleOffset, FIndicatorOffset: Byte;
    FUpdateLock: Byte;
    FLayoutLock: Byte;
    FInColExit: Boolean;
    FDefaultDrawing: Boolean;
    FSelfChangingTitleFont: Boolean;
    FSelecting: Boolean;
    FSelRow: Integer;
    FDataLink: TCSGridDataLink;
    FOnColEnter: TNotifyEvent;
    FOnColExit: TNotifyEvent;
    FOnDrawDataCell: TDrawDataCellEvent;
    FOnDrawColumnCell: TCSDrawColumnCellEvent;
    FEditText: string;
    FColumns: TCMoneyDBGridColumns;
    FOnEditButtonClick: TCSEditButtonClickEvent;
    FOnColumnMoved: TMovedEvent;
    FBookmarks: TCSBookmarkList;
    FSelectionAnchor: TBookmarkStr;
    FOnCellClick: TCMoneyDBGridClickEvent;
    FOnTitleClick: TCMoneyDBGridClickEvent;
    FOnGetCellParams: TCSGetCellParamsEvent;
    FOnGetFooterParams: TCSGetFooterParamsEvent;
    FHorzScrollBar: TCMoneyDBGridScrollBar;
    FVertScrollBar: TCMoneyDBGridScrollBar;
    FOptionsEx: TCMoneyDBGridOptions;
    FEditKeyValue: Variant;
    ThumbTracked: Boolean;
    FOnSortMarkingChanged: TNotifyEvent;
    FSortMarking: Boolean;
    FUpDownBitmap: TBitmap;
    FTopLeftVisible: Boolean;
    FSelection: TCMoneyDBGridSelection;
    FAutoDrag, FSelectedCellPressed: Boolean;
    FTitleImages: TCustomImageList;
    FAllowedOperations: TCMoneyDBGridAllowedOperations;
    FSizingIndex: Longint;
    FSizingPos, FSizingOfs: Integer;
    FSelfChangingFooterFont: Boolean;
    FFooterFont: TFont;
    FFooterColor: TColor;
    FHintFont: TFont;

    function GetMoneyColCount(ACol: Integer): Integer;
    procedure DoCellEditing; virtual;  //数据单元格进入编辑状态时触发
    procedure DoCalcFieldAfterInput(const Value: string); virtual;  //触发计算字段数值输入后的事件

    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; Select: Boolean);
    procedure ReadColumns(Reader: TReader);
    procedure RecordChanged(Field: TField);
    procedure SetIme;
    procedure SetColumns(Value: TCMoneyDBGridColumns);
    procedure SetDataSource(Value: TDataSource);
    procedure SetOptions(Value: TDBGridOptions);
    procedure SetSelectedField(Value: TField);
    procedure SetSelectedIndex(Value: Integer);
    procedure SetTitleFont(Value: TFont);
    procedure TitleFontChanged(Sender: TObject);
    procedure UpdateData;
    procedure UpdateActive;
    procedure UpdateIme;
    procedure UpdateScrollBar;
    procedure UpdateRowCount;  //获取数据表的纪录总数和确定脚注栏的高度等等
    procedure WriteColumns(Writer: TWriter);
    procedure CMExit(var Message: TMessage); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;