adbgrid.pas

来自「delphi编程控件」· PAS 代码 · 共 2,096 行 · 第 1/5 页

PAS
2,096
字号
unit adbgrid;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface

uses Classes, SysUtils, Windows, Messages, DB, Controls, Graphics,
  StdCtrls, Forms, adbtempl, aincsrch, afilter;
{$I aclver.inc}

type

TCustomAutoDBGrid = class;
TAutoGridLayout = class;
TAutoGridGroup = class;
TAutoGridGroups = class;
TAutoGridColumns = class;
TAutoGridColumn = class;
TAutoGridField = class;
TAutoGridFields = class;
TAutoDBGridTemplate = class;

TAutoGridColumnSort = (gcsNone, gcsDown, gcsUp);

TAutoGridColumn = class(TCollectionItem)
private
  FLevel : Integer;
  FLevelIndex : Integer;
  Columns : TAutoGridColumns;
  FWidth : Integer;
  FIsDown : Boolean;
  FGridField : TAutoGridField;
  FSorted : TAutoGridColumnSort;

  function GetAlignment : TAlignment;
  function GetCaption : String;
  function GetColor : TColor;
  function GetField : TField;
  function GetFont : TFont;
  function GetTitleAlignment : TAlignment;
  function GetTitleColor : TColor;
  function GetTitleFont : TFont;
  function GetDBDefControl : TAutoDBDefControl;
  function GetGridLayout : TAutoGridLayout;
  function GetLeft : Integer;
  function GetVisibleLeft : Integer;
  function GetRect : TRect;
  function GetRight : Integer;
  function GetRowRect(Index : Integer) : TRect;
  procedure SetSorted(Value : TAutoGridColumnSort);
  procedure SetLevel(Value : Integer);
  procedure SetLevelIndex(Value : Integer);
  procedure SetWidth(Value : Integer);

  procedure ReadFieldIndex(Reader: TReader);
  procedure WriteFieldIndex(Writer: TWriter);
protected
  procedure DefineProperties(Filer: TFiler); override;

  property IsDown : Boolean read FIsDown;
  property Left : Integer read GetLeft;
  property VisibleLeft : Integer read GetVisibleLeft;
  property Rect : TRect read GetRect;
  property Right : Integer read GetRight;
  property RowRect[Index : Integer] : TRect read GetRowRect;
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  function UseMaxGridHeight : Boolean;

  property Alignment : TAlignment read GetAlignment;
  property Caption : String read GetCaption;
  property Color : TColor read GetColor;
  property Field : TField read GetField;
  property Font : TFont read GetFont;
  property GridField : TAutoGridField read FGridField;
  property Sorted  : TAutoGridColumnSort read FSorted write SetSorted;
  property TitleAlignment : TAlignment read GetTitleAlignment;
  property TitleColor : TColor read GetTitleColor;
  property TitleFont : TFont read GetTitleFont;

  property DBDefControl : TAutoDBDefControl read GetDBDefControl;
  property GridLayout : TAutoGridLayout read GetGridLayout;
published
  property Level : Integer read FLevel write SetLevel;
  property LevelIndex : Integer read FLevelIndex write SetLevelIndex;
  property Width : Integer read FWidth write SetWidth;
end;

TAutoGridColumns = class(TCollection)
private
  FGroup : TAutoGridGroup;
  FAssignFlag : Boolean;

  function GetItem(Index : Integer) : TAutoGridColumn;
  function GetLevelColumnCount(Index : Integer) : Integer;
  function GetLevelItem(Index1, Index2 : Integer) : TAutoGridColumn;
  procedure SetItem(Index : Integer; Value : TAutoGridColumn);

  function GetGridLayout : TAutoGridLayout;
  function GetGroups : TAutoGridGroups;
protected
  procedure LevelsChanged;
  procedure UpdateColumnWidth(Level : Integer; AColumn : TAutoGridColumn);
  procedure UpdateLevelIndex(Level : Integer);
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
  property Groups : TAutoGridGroups read GetGroups;
public
  constructor Create(AGroup : TAutoGridGroup);
  function Add(AGridField : TAutoGridField) : TAutoGridColumn;
  procedure Assign(Source: TPersistent); override;
  procedure GetLevelColumnList(Index : Integer; List : TList);

  property GridLayout : TAutoGridLayout read GetGridLayout;
  property Group : TAutoGridGroup read FGroup;
  property LevelColumnCount[Index : Integer] : Integer read GetLevelColumnCount;
  property LevelItems[Index1, Index2 : Integer] : TAutoGridColumn read GetLevelItem;
  property Items[Index : Integer] : TAutoGridColumn read GetItem write SetItem; default;
end;

TGridGroupValue = (ggvColor, ggvFont, ggvAlignment);
TGridGroupValues = set of TGridGroupValue;

TAutoGridGroup = class(TCollectionItem)
private
  Groups : TAutoGridGroups;
  FColumns : TAutoGridColumns;
  FAssignedValues : TGridGroupValues;
  FAlignment : TAlignment;
  FCaption : String;
  FFont : TFont;
  FColor : TColor;
  FWidth : Integer;

  function GetAlignment : TAlignment;
  function GetColor : TColor;
  function GetFont : TFont;
  function GetGridLayout : TAutoGridLayout;
  function GetLeft : Integer;
  function GetVisibleLeft : Integer;
  function GetLevels : Integer;
  function GetMinWidth : Integer;
  function GetRect : TRect;
  function GetRight : Integer;
  procedure SetAlignment(Value : TAlignment);
  procedure SetColor(Value : TColor);
  procedure SetFont(Value : TFont);
  procedure SetCaption(Value : String);
  procedure SetColumns(Value : TAutoGridColumns);
  procedure SetWidth(Value : Integer);

  function IsAlignmentStored : Boolean;
  function IsColorStored : Boolean;
  procedure FontChanged(Sender : TObject);
  procedure Changed;

protected
  property Levels : Integer read GetLevels;
  property MinWidth : Integer read GetMinWidth;
  property InternalFont : TFont read GetFont;
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;

  procedure Assign(Source: TPersistent); override;

  function IsFontStored : Boolean;
  procedure RestoreDefaults;

  function DefaultAlignment : TAlignment;
  function DefaultColor : TColor;
  function DefaultFont : TFont;

  property AssignedValues : TGridGroupValues read FAssignedValues write FAssignedValues;
  property GridLayout : TAutoGridLayout read GetGridLayout;
  property Left : Integer read GetLeft;
  property VisibleLeft : Integer read GetVisibleLeft;
  property Rect : TRect read GetRect;
  property Right : Integer read GetRight;
published
  property Alignment : TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
  property Color : TColor read GetColor write SetColor stored IsColorStored;
  property Caption : String read FCaption write SetCaption;
  property Columns : TAutoGridColumns read FColumns write SetColumns;
  property Font : TFont read FFont write SetFont stored IsFontStored;
  property Width : Integer read FWidth write SetWidth;
end;

TAutoGridGroups = class(TCollection)
private
  FGridLayout : TAutoGridLayout;

  function GetHeight : Integer;
  function GetItem(Index : Integer) : TAutoGridGroup;
  function GetGridOwner : TComponent;
  procedure SetItem(Index : Integer; Value : TAutoGridGroup);
protected
  function GetLeftVis : Integer;
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(AGridLayout : TAutoGridLayout);
  destructor Destroy; override;
  function Add : TAutoGridGroup;
  procedure Assign(Source: TPersistent); override;

  property GridLayout : TAutoGridLayout read FGridLayout;
  property Height : Integer read GetHeight;
  property Items[Index : Integer] : TAutoGridGroup read GetItem write SetItem; default;
  property Owner : TComponent read GetGridOwner;
end;

TGridFieldValue = (gfvColor, gfvFont, gfvAlignment, gfvReadOnly, gfvTitleColor,
    gfvCaption, gfvTitleAlignment, gfvTitleFont);
TGridFieldValues = set of TGridFieldValue;

TAutoGridFieldClass = class of TAutoGridField;

TAutoGridField = class(TCollectionItem)
private
  FColumn : TAutoGridColumn;
  FField : TField;
  FFieldName : string;
  FColor : TColor;
  FFont : TFont;
  FAlignment : TAlignment;
  FReadonly : Boolean;
  FCaption : String;
  FTitleColor : TColor;
  FTitleFont : TFont;
  FTitleAlignment : TAlignment;
  FAssignedValues : TGridFieldValues;
  FCustomized : Boolean;
  FDBDefControl : TAutoDBDefControl;

  procedure FontChanged(Sender : TObject);
  procedure TitleFontChanged(Sender : TObject);
  function GetAlignment : TAlignment;
  function GetCaption : String;
  function GetColor : TColor;
  function GetField : TField;
  function GetFont : TFont;
  function GetReadOnly : Boolean;
  function GetTitleAlignment : TAlignment;
  function GetTitleColor : TColor;
  function GetTitleFont : TFont;

  function GetDBDefControl : TAutoDBDefControl;

  function IsAlignmentStored : Boolean;
  function IsCaptionStored: Boolean;  
  function IsColorStored : Boolean;
  function IsReadOnlyStored : Boolean;
  function IsTitleAlignmentStored : Boolean;
  function IsTitleColorStored : Boolean;

  procedure SetAlignment(Value : TAlignment);
  procedure SetCaption(Value : String);
  procedure SetColor(Value : TColor);
  procedure SetField(Value : TField);
  procedure SetFieldName(const Value : String);
  procedure SetFont(Value : TFont);
  procedure SetReadOnly(Value : Boolean);
  procedure SetTitleAlignment(Value : TAlignment);
  procedure SetTitleColor(Value : TColor);
  procedure SetTitleFont(Value : TFont);
protected
  function  GetGridLayout : TAutoGridLayout;
  procedure RefreshDefaultFont;
  procedure RefreshDefaultTitleFont;

  property InternalFont : TFont read GetFont;
  property InternalTitleFont : TFont read GetTitleFont;  
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source : TPersistent); override;

  function IsFontStored : Boolean;
  function IsTitleFontStored : Boolean;

  function DefaultAlignment : TAlignment;
  function DefaultCaption : String;
  function DefaultColor : TColor;
  function DefaultFont : TFont;
  function DefaultReadOnly : Boolean;
  function DefaultTitleAlignment : TAlignment;
  function DefaultTitleColor : TColor;
  function DefaultTitleFont : TFont;

  procedure RestoreDefaults;

  property AssignedValues : TGridFieldValues read FAssignedValues write FAssignedValues;
  property Customized : Boolean read FCustomized;
  property Column : TAutoGridColumn read FColumn;
  property DBDefControl : TAutoDBDefControl read GetDBDefControl;
  property Field : TField read GetField write SetField;
  property GridLayout : TAutoGridLayout read GetGridLayout;
published
  property  Alignment : TAlignment read GetAlignment write SetAlignment
     stored IsAlignmentStored;
  //Should be defined before Caption
  property FieldName : String read FFieldName write SetFieldName;
  property Caption : String read GetCaption write SetCaption stored IsCaptionStored;
  property Color : TColor read GetColor write SetColor stored IsColorStored;
  property Font : TFont read FFont write SetFont stored IsFontStored;
  property ReadOnly : Boolean read GetReadOnly write SetReadOnly
     stored IsReadOnlyStored;
  property TitleAlignment : TAlignment read GetTitleAlignment write SetTitleAlignment
     stored IsTitleAlignmentStored;
  property TitleColor : TColor read GetTitleColor write SetTitleColor stored IsTitleColorStored;
  property TitleFont : TFont read FTitleFont write SetTitleFont stored IsTitleFontStored;
end;

TAutoGridFields = class(TCollection)
private
  FGridLayout : TAutoGridLayout;
  FGetDefControlFast : Boolean;

  function GetField(Index : Integer): TAutoGridField;
  function GetCustomized : Boolean;
  procedure SetField(Index : Integer; Value : TAutoGridField);
  procedure SetCustomized(Value : Boolean);
protected
  procedure Update(Item : TCollectionItem); override;
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(AGridLayout : TAutoGridLayout);
  function Add : TAutoGridField;
  function GridFieldByField(AField : TField) : TAutoGridField;
  function GridFieldByFieldName(AFieldName : String) : TAutoGridField;  
  procedure Assign(Source: TPersistent); override;
  procedure RestoreDefaults;
  procedure RebuildFields;
  property Customized : Boolean read GetCustomized write SetCustomized;
  property GridLayout : TAutoGridLayout read FGridLayout;
  property Items[Index : Integer]: TAutoGridField read GetField write SetField; default;
end;

TAutoDBGridDataLink = class(TDataLink)
private
  FGridLayout : TAutoGridLayout;
  FFieldCount : Integer;
  FFieldMapSize : Integer;
  FFieldMap : Pointer;
  FModified : 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 RecordChanged(Field: TField); override;
  procedure UpdateData; override;
  function  GetMappedIndex(ColIndex: Integer): Integer;
public
  constructor Create(AGridLayout : TAutoGridLayout);
  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;

TAutoGridOption = (agoColumnDrag, agoConfirmDelete, agoIndicator, agoGroup,
                agoEditing, agoAlwaysShowEditor, agoTabs, agoSelectColumn);
TAutoGridOptions = set of TAutoGridOption;
TAutoColumnClick = procedure(Sender : TObject; AColumn : TAutoGridColumn) of object;

TAutoGridIncSearch = class(TCustomAutoControlIncSearch)
private
  FGridLayout : TAutoGridLayout;
protected
  function GetDBControl : TWinControl; override;
  function GetDataSource : TDataSource; override;
  function GetField : TField; override;
public
  function Execute : Boolean; override;
published
  property CaseInsensitive;
  property HotKey;
end;

TAutoGridCustomDrawEvent = procedure(Sender : TObject; ACanvas : TCanvas;
   AColumn : TAutoGridColumn; ARect : TRect; AFont : TFont; AIsSelected : Boolean;
   Var AColor : TColor; CustomDraw : Boolean) of object;

TAutoGridLayout = class(TPersistent)
private
  FDataLink : TAutoDBGridDataLink;
  FGroups : TAutoGridGroups;
  FFields : TAutoGridFields;
  FFont : TFont;
  FGroupFont : TFont;
  FColor : TColor;
  FColumnFont : TFont;
  FOwner : TComponent;
  FMaxLevel : Integer;
  FLevels : Integer;
  FFontHeight : Integer;
  FGroupFontHeight : Integer;
  FColumnFontHeight : Integer;
  FOptions : TAutoGridOptions;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?