cmoneydbgrids.pas

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

    procedure RefreshDefaultFont;
  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;
    procedure RestoreDefaults; virtual;
    function DisplayText: string;
    function GetColumnType: TCSColumnType;
    property Grid: TCChinaCustomDbGrid read GetGrid;
    property AssignedValues: TCSColumnValues read FAssignedValues;
    property Field: TField read GetField write SetField;
    property CheckboxState: TCheckBoxState read GetCheckboxState write SetCheckboxState;
    property CalcValue: double read FCalcValue;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property ButtonStyle: TCSColumnButtonStyle read FButtonStyle write SetButtonStyle default cbsAuto;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property DropDownRows: Cardinal read FDropDownRows write FDropDownRows default 7;
    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 Title: TCSColumnTitle read FTitle write SetTitle;
    property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    property AlwaysShowEditor: Boolean read FAlwaysShowEditor write SetAlwaysShowEditButton default False;
    property AutoFitColWidth: Boolean read GetAutoFitColWidth write SetAutoFitColWidth default True;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap stored IsWordWrapStored;
    property EndEllipsis: Boolean read FEndEllipsis write SetEndEllipsis default False;
    property DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth default 0;
    property LookupDisplayFields: string read GetLookupDisplayFields write SetLookupDisplayFields stored IsLookupDisplayFieldsStored;
    property AutoDropDown: Boolean read FAutoDropDown write SetAutoDropDown default False;
    property Visible: Boolean read FVisible write SetVisible default True;
    property KeyList: TStrings read GetKeykList write SetKeykList;
    property ImageList: TCustomImageList read FImageList write SetImageList;
    property NotInKeyListIndex: Integer read FNotInKeyListIndex write SetNotInKeyListIndex default -1;
    property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
    property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 0;
    property Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
    property ToolTips: Boolean read FToolTips write FToolTips default False;

    property InputStyle: TCSInputStyle read FInputStyle write FInputStyle default isDefault;
    property CalcType: TCSCalcType read FCalcType write SetCalcType default ctNone;
    property ShowCalcValue: Boolean read FShowCalcValue write SetShowCalcValue default False;
    property PromptOnEmpty: Boolean read FPromptOnEmpty write FPromptOnEmpty default False;
    property PromptText: string read FPromptText write FPromptText stored IsPromptTextStored;
    property DisplayStyle: TCSDisplayStyle read FDisplayStyle write SetDisplayStyle default dsNormal;
    property MoneyColCount: Integer read FMoneyColCount write SetMoneyColCount default 11;
    property DblClickNextValue: Boolean read FDblClickNextValue write FDblClickNextValue default False;
    property FixedWidth: Boolean read FFixedWidth write FFixedWidth default False;
    property MaxValue: Integer read FMaxValue write FMaxValue default 100;
    property ValueChecked: string read FValueChecked write FValueChecked stored IsValueCheckedStored;
    property ValueUnchecked: string read FValueUnchecked write FValueUnchecked stored IsValueUncheckedStored;
    //property CustomControl: TWinControl read FCustomControl write FCustomControl;
  end;

  TCSColumnClass = class of TCSColumn;


  TCMoneyDBGridColumns = class(TCollection)
  private
    FGrid: TCChinaCustomDbGrid;
    function GetColumn(Index: Integer): TCSColumn;
    function GetState: TDBGridColumnsState;
    procedure SetColumn(Index: Integer; Value: TCSColumn);
    procedure SetState(NewState: TDBGridColumnsState);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Grid: TCChinaCustomDbGrid; ColumnClass: TCSColumnClass);
    function Add: TCSColumn;
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(S: TStream);
    procedure RestoreDefaults;
    procedure RebuildColumns;
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(S: TStream);
    property State: TDBGridColumnsState read GetState write SetState;
    property Grid: TCChinaCustomDbGrid read FGrid;
    property Items[Index: Integer]: TCSColumn read GetColumn write SetColumn;
    default;
  end;


  TPassthroughColumnTitle = class(TCSColumnTitle)
  private
    procedure SetCaption(const Value: string); override;
  end;


  TPassthroughColumn = class(TCSColumn)
  private
    procedure SetAlignment(Value: TAlignment); override;
    procedure SetField(Value: TField); override;
    procedure SetReadOnly(Value: Boolean); override;
    procedure SetWidth(Value: Integer); override;
  protected
    function CreateTitle: TCSColumnTitle; override;
    procedure SetIndex(Value: Integer); override;
  end;


  TCSColumnsList = class(TList)
  private
    function GetColumn(Index: Integer): TCSColumn;
    procedure SetColumn(Index: Integer; const Value: TCSColumn);
  public
    property Items[Index: Integer]: TCSColumn read GetColumn write SetColumn;
    default;
  end;


  TColumnsWrapper = class(TComponent)
  private
    FColumns: TCMoneyDBGridColumns;
  published
    property Columns: TCMoneyDBGridColumns read FColumns write FColumns;
  end;


  TCSGridDataLink = class(TDataLink)
  private
    FGrid: TCChinaCustomDbGrid;
    FFieldCount: Integer;
    FFieldMapSize: Integer;
    FFieldMap: Pointer;
    FModified: Boolean;
    FInUpdateData: Boolean;
    FSparseMap: Boolean;
    function GetDefaultFields: Boolean;
    function GetFields(I: Integer): TField;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
    function GetMappedIndex(ColIndex: Integer): Integer;
  public
    constructor Create(AGrid: TCChinaCustomDbGrid);
    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;
  end;


  TCSBookmarkList = class
  private
    FList: TStringList;
    FGrid: TCChinaCustomDbGrid;
    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: TCChinaCustomDbGrid);
    destructor Destroy; override;
    procedure Clear; //清除书签
    procedure Delete; //从数据集删除所有已选择的行
    function Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
    function IndexOf(const Item: TBookmarkStr): Integer;
    function Refresh: Boolean;
    procedure SelectAll;
    property Count: Integer read GetCount;
    property CurrentRowSelected: Boolean read GetCurrentRowSelected write SetCurrentRowSelected;
    property Items[Index: Integer]: TBookmarkStr read GetItem;
    default;
  end;


  //多抬头
  TCSHeadTreeNode = class;

  LeafCol = record
    FLeaf: TCSHeadTreeNode;
    FColumn: TCSColumn;
  end;

  PLeafCol = ^LeafCol;
  TLeafCol = array[0..MaxListSize - 1] of LeafCol;
  PTLeafCol = ^TLeafCol;


  THeadTreeProc = procedure(node: TCSHeadTreeNode) of object;

  TCSHeadTreeNode = class(TObject)
  public
    Host: TCSHeadTreeNode;
    Child: TCSHeadTreeNode;
    Next: TCSHeadTreeNode;
    Text: string;
    Height: Integer;
    Width: Integer;
    WIndent: Integer;
    VLineWidth: Integer;
    Drawed: Boolean;
    HeightPrn: Integer;
    WidthPrn: Integer;
    Column: TCSColumn;
    constructor Create;
    constructor CreateText(AText: string; AHeight, AWidth: Integer);
    destructor Destroy; override;
    function Add(AAfter: TCSHeadTreeNode; AText: string; AHeight, AWidth: Integer): TCSHeadTreeNode;
    function AddChild(ANode: TCSHeadTreeNode; AText: string; AHeight, AWidth: Integer): TCSHeadTreeNode;
    function Find(ANode: TCSHeadTreeNode): Boolean;
    procedure Union(AFrom, ATo: TCSHeadTreeNode; AText: string; AHeight: Integer);
    procedure FreeAllChild;
    procedure CreateFieldTree(AGrid: TCChinaCustomDbGrid);
    procedure DoForAllNode(proc: THeadTreeProc);
  end;


  { TCSPopupListBox 弹出式列表框 }

  TCSPopupListBox = class(TCustomListBox)
  private
    FSearchText: string;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;


  { TCSPopupMonthCalendar 弹出式日历 }

  TCSPopupMonthCalendar = class(TMonthCalendar)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;


  { TCSInplaceEdit 网格数据编辑器 }

  TCSEditStyle = (esSimple, esEllipsis, esPickList, esDataList, esDateCalendar,
    esUpDown, esDropDown, esMoney, esCalculator, esCheckListBox, esProgressBar,
    esCheckBoxes, esCustomControl);  //辅助编辑器类型

  TCSInplaceEdit = class(TInplaceEdit)
  private
    FGrid: TCChinaCustomDbGrid;
    frmCalculator: TfrmPopCalculator;  //计算器
    FMoneyEdit: TCSMoneyEdit;  //金额编辑器
//    FCheckListBox: TCheckListBox;  //复选列表框

    FButtonWidth: Integer;
    FDataList: TDBLookupListBox;
    FPickList: TCSPopupListBox;
    FActiveList: TWinControl;
    FLookupSource: TDatasource;
    FEditStyle: TCSEditStyle;
    FListVisible: Boolean;
    FTracking: Boolean;
    FPressed: Boolean;
    FPopupMonthCalendar: TCSPopupMonthCalendar;
    FWordWrap: Boolean;
    FUpDown: TUpDown;

    procedure ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure UpDownChanging(Sender: TObject; var AllowChange: Boolean);
    procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SetEditStyle(Value: TCSEditStyle);
    procedure StopTracking;
    procedure TrackButton(X, Y: Integer);
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;