cmoneydbgrids.~pas

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

{******************************************************************************}
{                                                                              }
{                      SuperStart Visual Component Library                     }
{                                                                              }
{    Copyright(C) _2003   SuperStart Limited ComPany Copyright.                }
{                       Author :  ZCF  CreateDate: 1999.1.2                    }
{                       Last Modify :  Wuzh ModifyDate: 2004.5.5               }
{                                                                              }
{******************************************************************************}

unit CMoneyDBGrids;

{$I wuComp.inc}

{$RANGECHECKS OFF}  //不进行范围检查

interface

uses
  Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls, Graphics,
  Grids, DBCtrls, DB, Menus, DBGrids, Registry, ImgList, ComCtrls, DBConsts,
  Dialogs, IniFiles, CommCtrl, CMoneyInpEdt,
  {$IFDEF SDComp7} Variants, {$ENDIF}
  ExtCtrls, Mask, Buttons, Consts;

type
  TCSColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
    cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName, cvWordWrap,
    cvLookupDisplayFields);
  TCSColumnValues = set of TCSColumnValue;

  TCSColumnRestoreParam = (crpColIndex, crpColWidths, crpSortMarker, crpColVisible);
  TCSColumnRestoreParams = set of TCSColumnRestoreParam;

  TCMoneyDBGridRestoreParam = (grpColIndex, grpColWidths, grpSortMarker,
    grpColVisible, grpRowHeight);
  TCMoneyDBGridRestoreParams = set of TCMoneyDBGridRestoreParam;

  TCSSortMarker = (smNone, smDown, smUp);
  TCharSet = set of Char;

const
  CSColumnTitleValues = [cvTitleColor..cvTitleFont];

type
  TCSColumn = class;
  TCChinaCustomDbGrid = class;


  { TCSCalcDataLink 计算数据 }

  TCSCalcDataLink = class(TDataLink)
  private
    FColumn: TCSColumn;
    procedure SetCalcValue;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure DataSetScrolled(Distance: Integer); override;
  public
    constructor Create(AColumn: TCSColumn);
  end;


  { TSDMoneyEdit 金额编辑器}

  TCSMoneyEdit = class(TCustomControl)
  private
    FCurSel: Integer;  //指示光标的位置，分位为0、角位为1...
    FText: string;  //改变后的格式化文字
    FColCount: Integer;  //金额显示的位数的长度
    FDoubleValue: Extended;  //改变前的值
    FCaretGlyph: TBitmap;  //显示光标的图案（本Control中用三角形光标，后改成下划线）
    FGrid: TCChinaCustomDbGrid;  //从属的父TCChinaCustomDbGrid，用于对从属的父TCChinaCustomDbGrid的控制
    FFontSize: Integer;  //字体的大小
    FOldValue: string;
    procedure TextToValue;  //将显示的格式化文字转换成数值
    function GetCurPos(X, Y: Integer): Integer;  //获取指示光标的位置
    procedure SetCaretPosXY;  //设置指示光标的位置
    function GetValue: Double;  //取数值，因为数据类型不同
    procedure SetValue(Value: Double);  //给数值赋值，因为数据类型不同
    function GetControlText: string;  //将数值格式化，取要显示的字符串
    procedure SetControlText(Value: string);  //取数进行编辑并格式化处理
    function GetValueText: string;  //取要显示的字符串
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Changed: Boolean;
    property ControlText: string read GetControlText write SetControlText;  //改变前的显示的格式化文字
    property DoubleValue: Double read GetValue write SetValue;  //经过TextToValue转换后的数值，即修改值
    property ValueText: string read GetValueText;  //改变前的带小数位的数值文字，只读
  end;


  { TCSColumnTitle 列抬头 }

  TCSColumnTitle = class(TPersistent)
  private
    FColumn: TCSColumn;
    FCaption: string;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
    FEndEllipsis: Boolean;
    FSortIndex: Integer;
    FHint: string;
    FImageIndex: Integer;
    FToolTips: Boolean;
    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;
    procedure SetEndEllipsis(const Value: Boolean);
    procedure SetSortIndex(Value: Integer);
    procedure SetImageIndex(const Value: Integer);
  protected
    FTitleButton: Boolean;
    FSortMarker: TCSSortMarker;
    procedure SetTitleButton(Value: Boolean);
    procedure SetSortMarker(Value: TCSSortMarker);
    procedure RefreshDefaultFont;
    function GetSortMarkingWidth: Integer;
  public
    constructor Create(Column: TCSColumn);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    function DefaultCaption: string;
    procedure RestoreDefaults; virtual;
    procedure SetNextSortMarkerValue(KeepMulti: Boolean);
  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;
    property TitleButton: Boolean read FTitleButton write SetTitleButton default False;
    property SortMarker: TCSSortMarker read FSortMarker write SetSortMarker default smNone;
    property EndEllipsis: Boolean read FEndEllipsis write SetEndEllipsis default False;
    property SortIndex: Integer read FSortIndex write SetSortIndex default 0;
    property Hint: string read FHint write FHint;
    property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
    property ToolTips: Boolean read FToolTips write FToolTips default False;
  end;


  TCSColumnType = (ctCommon, ctPickList, ctLookupField, ctKeyPickList,
    ctKeyImageList);  //列类型
  TCSColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone, cbsUpDown,
    cbsDropDown, cbsCalendar, cbsCalculator, cbsCheckListBox{, cbsColorPicker});  //按钮类型
  TCSInputStyle = (isDefault, isString, isInteger, isFloat);  //输入控制
  TCSCalcType = (ctNone, ctSum, ctCount, ctAveg, ctMax, ctMin);  //计算类型
  TCSDisplayStyle = (dsNormal, dsMoney, dsProgressBar, dsCheckBoxes);  //显示状态

  { TCSColumn 网格列 }

  TCSColumn = class(TCollectionItem)
  private
    FMoneyColCount: Integer;  //金额数位
    FDisplayStyle: TCSDisplayStyle;  //显示形式
    FCalcDataLink: TCSCalcDataLink;
    FCalcType: TCSCalcType;  //脚注栏计算类型
    FCalcValue: double;  //数值类型字段的计算值
    FShowCalcValue: Boolean;  //是否在脚注栏显示计算值
    FPromptOnEmpty: Boolean;  //数据为空是否显示提示文字
    FPromptText: string;  //数据为空显示的提示文字
    FDblClickNextValue: Boolean;  //双击自动取本字段的下一个数值
    FFixedWidth: Boolean;  //是否能够改变网格列的宽度
    FMaxValue: Integer;  //进度条的最大值
    FValueChecked: string;  //CheckBox的Checked值
    FValueUnchecked: string;  //CheckBox的Unchecked值
    FCustomControl: TWinControl;  //可以外挂的数据编辑器

    FField: TField;
    FFieldName: string;
    FColor: TColor;
    FWidth: Integer;
    FTitle: TCSColumnTitle;
    FFont: TFont;
    FImeMode: TImeMode;
    FImeName: TImeName;
    FPickList: TStrings;
    FPopupMenu: TPopupMenu;
    FDropDownRows: Cardinal;
    FButtonStyle: TCSColumnButtonStyle;
    FAlignment: TAlignment;
    FReadonly: Boolean;
    FAssignedValues: TCSColumnValues;
    FVisible: Boolean;
    FKeyList: TStrings;
    FImageList: TCustomImageList;
    FNotInKeyListIndex: Integer;
    FMinWidth: Integer;
    FMaxWidth: Integer;
    FNotInWidthRange: Boolean;
    FIncrement: Extended;
    FToolTips: Boolean;
    FInputStyle: TCSInputStyle;

    procedure FontChanged(Sender: TObject);
    function GetAlignment: TAlignment;
    function GetColor: TColor;
    function GetField: TField;
    function GetFont: TFont;
    function GetImeMode: TImeMode;
    function GetImeName: TImeName;
    function GetPickList: TStrings;
    function GetReadOnly: Boolean;
    function GetWidth: Integer;
    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: TCSColumnButtonStyle);
    procedure SetColor(Value: TColor);
    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: TCSColumnTitle);
    procedure SetWidth(Value: Integer); virtual;
    procedure SetVisible(const Value: Boolean);
    function GetKeykList: TStrings;
    procedure SetKeykList(const Value: TStrings);
    procedure SetNotInKeyListIndex(const Value: Integer);
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetMaxWidth(const Value: Integer);
    procedure SetMinWidth(const Value: Integer);
    function GetCheckBoxState: TCheckBoxState;
    procedure SetCheckBoxState(const Value: TCheckBoxState);
    function IsIncrementStored: Boolean;

    function IsPromptTextStored: Boolean;
    function IsValueCheckedStored: Boolean;
    function IsValueUncheckedStored: Boolean;
    procedure SetCalcType(const Value: TCSCalcType);
    procedure SetDisplayStyle(const Value: TCSDisplayStyle);
    procedure SetMoneyColCount(const Value: Integer);
    procedure SetShowCalcValue(const Value: Boolean);
  protected
    FInitWidth: Integer;
    FAutoFitColWidth: Boolean;
    FWordWrap: Boolean;
    FEndEllipsis: Boolean;
    FDropDownWidth: Integer;
    FLookupDisplayFields: string;
    FAlwaysShowEditor: Boolean;
    FAutoDropDown: Boolean;
    function GetAutoFitColWidth: Boolean;
    function GetLookupDisplayFields: string;
    function GetWordWrap: Boolean;
    function IsWordWrapStored: Boolean;
    function IsLookupDisplayFieldsStored: Boolean;
    function DefaultLookupDisplayFields: string;
    function DefaultWordWrap: Boolean;
    procedure SetAlwaysShowEditButton(Value: Boolean);
    procedure SetAutoDropDown(Value: Boolean);
    procedure SetAutoFitColWidth(Value: Boolean); virtual;
    procedure SetWordWrap(Value: Boolean); virtual;
    procedure SetLookupDisplayFields(Value: string); virtual;
    procedure SetDropDownWidth(Value: Integer);
    procedure SetEndEllipsis(const Value: Boolean);
    procedure SetNextFieldValue(Increment: Extended);
    function CanModify(TryEdit: Boolean): Boolean;
    function AllowableWidth(TryWidth: Integer): Integer;
    function CreateTitle: TCSColumnTitle; virtual;
    function GetGrid: TCChinaCustomDbGrid;
    function GetDisplayName: string; override;