dbgrideh.pas

很COOL的GRID控件

{*******************************************************}
{                                                       }
{                       EhLib v1.54                     }
{                   TDBGridEh component                 }
{                                                       }
{   Copyright (c) 1998, 2000 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}


//{$define eval}

unit DBGridEh;

{$R-}
{$I EhLib.Inc}

interface

uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  Graphics, Grids,EhGrids, DBCtrls, Db, Menus, DBGrids, Registry, DBSumLst,EhUtils
{$IFDEF EH_LIB_4} ,ImgList{$ENDIF}
{$IFNDEF EH_LIB_4} {Borland Delphi 3.0 or C++ Builder 3.0}
,MonthCal
{$ENDIF}
  {,dbugintf};

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

  TColumnFooterEhValue = (cvFooterAlignment, cvFooterFont, cvFooterColor);
  TColumnFooterValues = set of TColumnFooterEhValue;

  TColumnEhRestoreParam = (crpColIndexEh,crpColWidthsEh,crpSortMarkerEh,crpColVisibleEh);
  TColumnEhRestoreParams = set of TColumnEhRestoreParam;

  TDBGridEhRestoreParam = (grpColIndexEh,grpColWidthsEh,grpSortMarkerEh,grpColVisibleEh,grpRowHeightEh);
  TDBGridEhRestoreParams = set of TDBGridEhRestoreParam;


const
  ColumnEhTitleValues = [cvTitleColor..cvTitleFont];
  ColumnEhFooterValues = [cvFooterAlignment..cvFooterColor];
(*  cm_DeferLayout = WM_USER + 100; *)

{ TColumnEh defines internal storage for column attributes.  Values assigned
  to properties are stored in this object, the grid- or field-based default
  sources are not modified.  Values read from properties are the previously
  assigned value, if any, or the grid- or field-based default values if
  nothing has been assigned to that property. This class also publishes the
  column attribute properties for persistent storage.  }

type
  TColumnEh = class;
  TCustomDBGridEh = class;

  TSortMarkerEh = (smNoneEh, smDownEh, smUpEh);

  TColumnTitleEh = class(TPersistent)
  private
    FColumn: TColumnEh;
    FCaption: string;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
    //ddd
    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);
    function GetToolTips:Boolean;
    procedure SetToolTips(const Value: Boolean);
  protected
    //ddd
    FTitleButton: Boolean;
    FSortMarker: TSortMarkerEh;
    procedure SetTitleButton(Value: Boolean);
    procedure SetSortMarker(Value: TSortMarkerEh);
    //\\\
    procedure RefreshDefaultFont;
    function  GetSortMarkingWidth:Integer;
  public
    constructor Create(Column: TColumnEh);
    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;
    //ddd
    property TitleButton: Boolean read FTitleButton write SetTitleButton default False;
    property SortMarker: TSortMarkerEh read FSortMarker write SetSortMarker default smNoneEh;
    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 GetToolTips write SetToolTips default False;
    //\\\
  end;


  //ddd
  TFooterValueType = (fvtNon,fvtSum,fvtCount,fvtFieldValue,fvtStaticText);

  TColumnFooterEh = class(TCollectionItem)
  private
    FColumn: TColumnEh;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
    FEndEllipsis: Boolean;
    FValue:String;
    FFieldName: string;
    FValueType: TFooterValueType;
    FWordWrap: Boolean;
    FAssignedValues: TColumnFooterValues;
    procedure FontChanged(Sender: TObject);
    function GetAlignment: TAlignment;
    function GetColor: TColor;
    function GetFont: TFont;
    function IsAlignmentStored: Boolean;
    function IsColorStored: Boolean;
    function IsFontStored: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetEndEllipsis(const Value: Boolean);
    procedure SetFieldName(const Value: String);
    procedure SetValueType(const Value: TFooterValueType);
    procedure SetValue(const Value: String);
    procedure SetWordWrap(const Value: Boolean);
  protected
    FDBSum:TDBSum;
    procedure RefreshDefaultFont;
  public
    constructor Create(Collection: TCollection); override;
    constructor CreateApart(Column: TColumnEh);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    procedure EnsureSumValue;
    procedure RestoreDefaults; virtual;
    property  AssignedValues: TColumnFooterValues read FAssignedValues;
    property Column: TColumnEh read FColumn;
  published
    property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property Color: TColor read GetColor write SetColor stored IsColorStored;
    property Font: TFont read GetFont write SetFont stored IsFontStored;
    property EndEllipsis: Boolean read FEndEllipsis write SetEndEllipsis default False;
    property ValueType: TFooterValueType read FValueType write SetValueType default fvtNon;
    property FieldName: String read FFieldName write SetFieldName;
    property Value: String read FValue write SetValue;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  end;


  TColumnFooterEhClass = class of TColumnFooterEh;

  TColumnFootersEh = class(TCollection)
  private
    FColumn: TColumnEh;
    function GetFooter(Index: Integer): TColumnFooterEh;
    procedure SetFooter(Index: Integer; Value: TColumnFooterEh);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Column: TColumnEh; FooterClass: TColumnFooterEhClass);
    function  Add: TColumnFooterEh;
    property Column: TColumnEh read FColumn;
    property Items[Index: Integer]: TColumnFooterEh read GetFooter write SetFooter; default;
  end;

  //\\\

  //ddd
  TColumnEhType = (ctCommon, ctPickList, ctLookupField, ctKeyPickList, ctKeyImageList, ctCheckboxes);
  TColumnButtonStyleEh = (cbsAuto, cbsEllipsis, cbsNone, cbsUpDown, cbsDropDown);
  //\\\

  TColumnEh = class(TCollectionItem)
  private
    FField: TField;
    FFieldName: string;
    FColor: TColor;
    FWidth: Integer;
    FTitle: TColumnTitleEh;
    FFont: TFont;
    FImeMode: TImeMode;
    FImeName: TImeName;
    FPickList: TStrings;
    FPopupMenu: TPopupMenu;
    FDropDownRows: Cardinal;
    FButtonStyle: TColumnButtonStyleEh;
    FAlignment: TAlignment;
    FReadonly: Boolean;
    FAssignedValues: TColumnEhValues;
    FFooter: TColumnFooterEh;
    FVisible: Boolean;
    //ddd
    FKeyList: TStrings;
    FImageList: {$IFDEF EH_LIB_4}TCustomImageList{$ELSE}TImageList{$ENDIF};
    FNotInKeyListIndex: Integer;
    FMinWidth: Integer;
    FMaxWidth: Integer;
    FNotInWidthRange:Boolean;
    FDblClickNextVal: Boolean;
    FCheckboxes: Boolean;
    FIncrement: Extended;
    FToolTips: Boolean;
    FFooters: TColumnFootersEh;
    //\\\
//由茶壶 Dennis Dennis加入
        FCurrency: Boolean;
//        FLayout: TTextLayout;
//由茶壶 Dennis Dennis加入end
    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: TColumnButtonStyleEh);
    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: TColumnTitleEh);
    procedure SetWidth(Value: Integer); virtual;
    //ddd
    procedure SetFooter(const Value: TColumnFooterEh);
    procedure SetVisible(const Value: Boolean);
    function GetKeykList: TStrings;
    procedure SetKeykList(const Value: TStrings);
    procedure SetNotInKeyListIndex(const Value: Integer);
    procedure SetImageList(const Value: {$IFDEF EH_LIB_4}TCustomImageList{$ELSE}TImageList{$ENDIF});
    procedure SetMaxWidth(const Value: Integer);
    procedure SetMinWidth(const Value: Integer);
    function GetCheckboxes: Boolean;
    procedure SetCheckboxes(const Value: Boolean);
    function DefaultCheckboxes: Boolean;
    function GetCheckboxState: TCheckBoxState;
    procedure SetCheckboxState(const Value: TCheckBoxState);
    function  IsCheckboxesStored: Boolean;
    function IsIncrementStored: Boolean;
    function GetToolTips:Boolean;
    procedure SetToolTips(const Value: Boolean);
    procedure SetFooters(const Value: TColumnFootersEh);
    //\\\
  protected
//ddd
    FInitWidth:Integer;
    FAutoFitColWidth:Boolean;
    FWordWrap:Boolean;
    FEndEllipsis: Boolean;
    FDropDownWidth: Integer;
    FLookupDisplayFields:String;
    FAlwaysShowEditButton: 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);
    function  CreateFooter: TColumnFooterEh; virtual;
    procedure SetNextFieldValue(Increment: Extended);
    function  CanModify(TryEdit:Boolean):Boolean;
    function  AllowableWidth(TryWidth:Integer):Integer;
    procedure EnsureSumValue;
//\\\
    function  CreateTitle: TColumnTitleEh; virtual;
    function  CreateFooters: TColumnFootersEh; virtual;
    function  GetGrid: TCustomDBGridEh;
    function GetDisplayName: string; override;
    procedure RefreshDefaultFont;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;