dbgrideh.pas

Dbgrid 增强(附源码):支持多表头,多固定列,按表头排序,支持合计列,并支持直接打印

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


//{$define eval}

unit DBGridEh;

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

interface

uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  Graphics, Grids, DBCtrls, Db, Menus, DBGrids, Registry, DBSumLst
{$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, cvFooterAlignment, cvFooterFont, cvFooterColor, cvCheckboxes);
  TColumnEhValues = set of TColumnEhValue;

  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;
    //\\\
    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
    //ddd
    FTitleButton: Boolean;
    FSortMarker: TSortMarkerEh;
    procedure SetTitleButton(Value: Boolean);
    procedure SetSortMarker(Value: TSortMarkerEh);
    //\\\
    procedure RefreshDefaultFont;
  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;
    //\\\
  end;


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

  TColumnFooterEh = class(TPersistent)
  private
    FColumn: TColumnEh;
    FFont: TFont;
    FColor: TColor;
    FAlignment: TAlignment;
    FEndEllipsis: Boolean;
    FValue:String;
    FFieldName: string;
    FValueType: TFooterValueType;
    FWordWrap: Boolean;
    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
    procedure RefreshDefaultFont;
  public
    constructor Create(Column: TColumnEh);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function DefaultAlignment: TAlignment;
    function DefaultColor: TColor;
    function DefaultFont: TFont;
    procedure RestoreDefaults; virtual;
    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;
  //\\\

  //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;
    //\\\
    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;
    //\\\
  protected
//ddd
    FInitWidth:Integer;
    FAutoFitColWidth:Boolean;
    FWordWrap:Boolean;
    FEndEllipsis: Boolean;
    FDropDownWidth: Integer;
    FLookupDisplayFields:String;
    FAlwaysShowEditButton: Boolean;
    FAutoDropDown: Boolean;
    FDBSum:TDBSum;
    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  GetGrid: TCustomDBGridEh;
    function GetDisplayName: string; override;
    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;
    //ddd
    function  DisplayText: String;
    function  GetColumnType: TColumnEhType;
    //\\\
    property  Grid: TCustomDBGridEh read GetGrid;
    property  AssignedValues: TColumnEhValues read FAssignedValues;
    property  Field: TField read GetField write SetField;
    property  CheckboxState: TCheckBoxState read GetCheckboxState write SetCheckboxState;
  published
    property  Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property  ButtonStyle: TColumnButtonStyleEh 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: TColumnTitleEh read FTitle write SetTitle;
    property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    //ddd
    property  AlwaysShowEditButton: Boolean read FAlwaysShowEditButton 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  Footer: TColumnFooterEh read FFooter write SetFooter;
    property  Visible: Boolean read FVisible write SetVisible default True;
    property  KeyList: TStrings read GetKeykList write SetKeykList;
    property  ImageList: {$IFDEF EH_LIB_4}TCustomImageList{$ELSE}TImageList{$ENDIF} 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  DblClickNextVal: Boolean read FDblClickNextVal write FDblClickNextVal  default False;
    property  Checkboxes: Boolean read GetCheckboxes write SetCheckboxes stored IsCheckboxesStored;