WEB开发网
开发学院软件开发Delphi 让你的DBGrid竖着站(1) 阅读

让你的DBGrid竖着站(1)

 2006-02-04 13:54:13 来源:WEB开发网   
核心提示:{File Name.......: DBVGrids.zipFile Description: Implementation of a Vertical DBGrid based on Vcl's DBGrids.pas.Targets.........: Delphi 3.Author Name.....:
{
File Name.......: DBVGrids.zip
File Description: Implementation of a Vertical DBGrid based on Vcl's DBGrids.pas.
Targets.........: Delphi 3.
Author Name.....: George Vavoylogiannis
EMail...........: georgev@hol.gr
WEB.............: http://users.hol.gr/~georgev
File Status.....: Freeware
Category........: Database components.


  For a long time till a few months, i was trying to find a solution for
  vertical grid. I found a few grid components that claimed to be vertical, but
  this was far from tue.
  So one day i decided to have a better look at the DBGrids.pas in Borland VCL source.
  "Bit by bit" as we say in Greece i started changing the code and finally
  a TRUE VERTICAL DBGRID component is what we have here.

  I wonder why Borland did't think about this. After all it seems so SIMPLE!!!

  NEW PROPERTIES
  Vertical: Boolean, set to True and and the grid becomes VERTICAL
  OnlyOne: Boolean, set to true if you want the grid to display only one record
      at a time (the curent record).
  TitlesWidth: integer, set the vertical column title's width.

  NOTE: because all the code is duplicated from the VCL, all the classes are
  redefined (TColumn, TDBGridColumns, TGridDatalink e.t.c).
  The columns editor works fine except that it does not bring the fields list.
  This is something that i may do in future versions but if someone find's a
  way to solve it or even has property editor for the columns please drop me
  an E-Mail.


Free to use and redistribute, but my name must
appear somewhere in the source code, or in the software.
No warranty is given by the author, expressed or implied.

WARNING! THE CODE IS PROVIDED AS IS WITH NO GUARANTEES OF ANY KIND!
USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE FOR
ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!

}
{**********************************************************************************}

unit DBVGrids;

{$R-}

interface

uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  Graphics, Grids, DBCtrls, Db, Menus, DBGrids, Variants;

type
  TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
   cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName);
  TColumnValues = set of TColumnValue;

const
  ColumnTitleValues = [cvTitleColor..cvTitleFont];
  cm_DeferLayout = WM_USER + 100;

{ TColumn 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
  TColumn = class;
  TCustomVDBGrid = class;

  TColumnTitle = class(TPersistent)
  private
   FColumn: TColumn;
   FCaption: string;
   FFont: TFont;
   FColor: TColor;
   FAlignment: TAlignment;
   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;
  protected
   procedure RefreshDefaultFont;
  public
   constructor Create(Column: TColumn);
   destructor Destroy; override;
   procedure Assign(Source: TPersistent); override;
   function DefaultAlignment: TAlignment;
   function DefaultColor: TColor;
   function DefaultFont: TFont;
   function DefaultCaption: string;
   procedure RestoreDefaults; virtual;
  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;
  end;

  TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);

  TColumn = class(TCollectionItem)
  private
   FField: TField;
   FFieldName: string;
   FColor: TColor;
   FWidth: Integer;
   FTitle: TColumnTitle;
   FFont: TFont;
   FImeMode: TImeMode;
   FImeName: TImeName;
   FPickList: TStrings;
   FPopupMenu: TPopupMenu;
   FDropDownRows: Cardinal;
   FButtonStyle: TColumnButtonStyle;
   FAlignment: TAlignment;
   FReadonly: Boolean;
   FAssignedValues: TColumnValues;
   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: TColumnButtonStyle);
   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: TColumnTitle);
   procedure SetWidth(Value: Integer); virtual;
  protected
   function  CreateTitle: TColumnTitle; virtual;
   function  GetGrid: TCustomVDBGrid;
   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;
   property  Grid: TCustomVDBGrid read GetGrid;
   property  AssignedValues: TColumnValues read FAssignedValues;
   property  Field: TField read GetField write SetField;
  published
   property  Alignment: TAlignment read GetAlignment write SetAlignment
    stored IsAlignmentStored;
   property  ButtonStyle: TColumnButtonStyle 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: TColumnTitle read FTitle write SetTitle;
   property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
  end;

  TColumnClass = class of TColumn;

  TDBGridColumnsState = (csDefault, csCustomized);

  TDBGridColumns = class(TCollection)
  private
   FGrid: TCustomVDBGrid;
   function GetColumn(Index: Integer): TColumn;
   function GetState: TDBGridColumnsState;
   procedure SetColumn(Index: Integer; Value: TColumn);
   procedure SetState(NewState: TDBGridColumnsState);
  protected
   function GetOwner: TPersistent; override;
   procedure Update(Item: TCollectionItem); override;
  public
   constructor Create(Grid: TCustomVDBGrid; ColumnClass: TColumnClass);
   function  Add: TColumn;
   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: TCustomVDBGrid read FGrid;
   property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
  end;

  TGridDataLink = class(TDataLink)
  private
   FGrid: TCustomVDBGrid;
   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: TCustomVDBGrid);
   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;

  TBookmarkList = class
  private
   FList: TStringList;
   FGrid: TCustomVDBGrid;
   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: TCustomVDBGrid);
   destructor Destroy; override;
   procedure Clear;      // free all bookmarks
   procedure Delete;      // delete all selected rows from dataset
   function  Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
   function  IndexOf(const Item: TBookmarkStr): Integer;
   function  Refresh: Boolean;// drop orphaned bookmarks; True = orphans found
   property Count: Integer read GetCount;
   property CurrentRowSelected: Boolean read GetCurrentRowSelected
    write SetCurrentRowSelected;
   property Items[Index: Integer]: TBookmarkStr read GetItem; default;
  end;

  TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
   dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
   dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect);
  TDBGridOptions = set of TDBGridOption;

  { The VDBGrid's DrawDataCell virtual method and OnDrawDataCell event are only
   called when the grid's Columns.State is csDefault.  This is for compatibility
   with existing code. These routines don't provide sufficient information to
   determine which column is being drawn, so the column attributes aren't
   easily accessible in these routines.  Column attributes also introduce the
   possibility that a column's field may be nil, which would break existing
   DrawDataCell code.  DrawDataCell, OnDrawDataCell, and DefaultDrawDataCell
   are obsolete, retained for compatibility purposes. }
  TDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
   State: TGridDrawState) of object;

  { The VDBGrid's DrawColumnCell virtual method and OnDrawColumnCell event are
   always called, when the grid has defined column attributes as well as when
   it is in default mode.  These new routines provide the additional
   information needed to access the column attributes for the cell being
   drawn, and must support nil fields.  }

  TDrawColumnCellEvent = procedure (Sender: TObject; const Rect: TRect;
   DataCol: Integer; Column: TColumn; State: TGridDrawState) of object;
  TDBGridClickEvent = procedure (Column: TColumn) of object;

  TCustomVDBGrid = class(TCustomGrid)
  private
   FIndicators: TImageList;
   FTitleFont: TFont;
   FReadOnly: Boolean;
   FOriginalImeName: TImeName;
   FOriginalImeMode: TImeMode;
   FUserChange: Boolean;
   FLayoutFromDataset: Boolean;
   FOptions: TDBGridOptions;
   FTitleOffset, FIndicatorOffset: Byte;
   FUpdateLock: Byte;
   FLayoutLock: Byte;
   FInColExit: Boolean;
   FDefaultDrawing: Boolean;
   FSelfChangingTitleFont: Boolean;
   FSelecting: Boolean;
   FSelRow: Integer;
   FDataLink: TGridDataLink;
   FOnColEnter: TNotifyEvent;
   FOnColExit: TNotifyEvent;
   FOnDrawDataCell: TDrawDataCellEvent;
   FOnDrawColumnCell: TDrawColumnCellEvent;
   FEditText: string;
   FColumns: TDBGridColumns;
   FOnEditButtonClick: TNotifyEvent;
   FOnColumnMoved: TMovedEvent;
   FBookmarks: TBookmarkList;
   FSelectionAnchor: TBookmarkStr;
   FVertical: Boolean;
   FOnlyOne: Boolean;
   FTitlesWidth: integer;
   FOnCellClick: TDBGridClickEvent;
   FOnTitleClick:TDBGridClickEvent;
   function AcquireFocus: Boolean;
   procedure DataChanged;
   procedure EditingChanged;
   function GetDataSource: TDataSource;
   function GetFieldCount: Integer;
   function GetFields(FieldIndex: Integer): TField;
   function GetSelectedField: TField;
   function GetSelectedIndex: Integer;
   procedure InternalLayout;
   procedure MoveCol(RawCol: Integer);
   procedure ReadColumns(Reader: TReader);
   procedure RecordChanged(Field: TField);
   procedure SetIme;
   procedure SetColumns(Value: TDBGridColumns);
   procedure SetDataSource(Value: TDataSource);
   procedure SetOptions(Value: TDBGridOptions);
   procedure SetSelectedField(Value: TField);
   procedure SetSelectedIndex(Value: Integer);
   procedure SetTitleFont(Value: TFont);
   procedure TitleFontChanged(Sender: TObject);
   procedure UpdateData;
   procedure UpdateActive;
   procedure UpdateIme;
   procedure UpdateScrollBar;
   procedure UpdateRowCount;
   procedure WriteColumns(Writer: TWriter);
   procedure SetVertical(Value: Boolean);
   procedure SetOnlyOne(Value: Boolean);
   procedure SetTitlesWidth(Value: integer);
   function TabStopRow(Arow: integer): Boolean;
   procedure CMExit(var Message: TMessage); message CM_EXIT;
   procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
   procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
   procedure CMDeferLayout(var Message); message cm_DeferLayout;
   procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
   procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
   procedure WMSize(var Message: TWMSize); message WM_SIZE;
   procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
   procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
   procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
   procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFOCUS;
   procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
  protected
   FUpdateFields: Boolean;
   FAcquireFocus: Boolean;
   FUpdatingEditor: Boolean;
   function  RawToDataColumn(ACol: Integer): Integer;
   function  DataToRawColumn(ACol: Integer): Integer;
   function  AcquireLayoutLock: Boolean;
   procedure BeginLayout;
   procedure BeginUpdate;
   procedure CancelLayout;
   function  CanEditAcceptKey(Key: Char): Boolean; override;
   function  CanEditModify: Boolean; override;
   function  CanEditShow: Boolean; override;
   procedure CellClick(Column: TColumn); dynamic;
   procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
   procedure RowMoved(FromIndex, ToIndex: Longint); override;
   procedure ColEnter; dynamic;
   procedure ColExit; dynamic;
   procedure ColWidthsChanged; override;
   function  CreateColumns: TDBGridColumns; dynamic;
   function  CreateEditor: TInplaceEdit; override;
   procedure CreateWnd; override;
   procedure DeferLayout;
   procedure DefaultHandler(var Msg); override;
   procedure DefineFieldMap; virtual;
   procedure DefineProperties(Filer: TFiler); override;
   procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
   procedure DrawDataCell(const Rect: TRect; Field: TField;
    State: TGridDrawState); dynamic; { obsolete }
   procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
    Column: TColumn; State: TGridDrawState); dynamic;
   procedure EditButtonClick; dynamic;
   procedure EndLayout;
   procedure EndUpdate;
   function  GetColField(DataCol: Integer): TField;
   function  GetEditLimit: Integer; override;
   function  GetEditMask(ACol, ARow: Longint): string; override;
   function  GetEditText(ACol, ARow: Longint): string; override;
   function  GetFieldValue(ACol: Integer): string;
   function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
    AState: TGridDrawState): Boolean; virtual;
   procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   procedure KeyPress(var Key: Char); override;
   procedure LayoutChanged; virtual;
   procedure LinkActive(Value: Boolean); virtual;
   procedure Loaded; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
   procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   procedure Scroll(Distance: Integer); virtual;
   procedure SetColumnAttributes; virtual;
   procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
   function  StoreColumns: Boolean;
   procedure TimedScroll(Direction: TGridScrollDirection); override;
   procedure TitleClick(Column: TColumn); dynamic;
   property Columns: TDBGridColumns read FColumns write SetColumns;
   property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
   property DataSource: TDataSource read GetDataSource write SetDataSource;
   property DataLink: TGridDataLink read FDataLink;
   property IndicatorOffset: Byte read FIndicatorOffset;
   property LayoutLock: Byte read FLayoutLock;
   property Options: TDBGridOptions read FOptions write SetOptions
    default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
    dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
   property ParentColor default False;
   property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
   property SelectedRows: TBookmarkList read FBookmarks;
   property TitleFont: TFont read FTitleFont write SetTitleFont;
   property UpdateLock: Byte read FUpdateLock;
   property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
   property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
   property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell
    write FOnDrawDataCell; { obsolete }
   property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell
    write FOnDrawColumnCell;
   property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
    write FOnEditButtonClick;
   property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
   property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
   property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
    State: TGridDrawState); { obsolete }
   procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
    Column: TColumn; State: TGridDrawState);
   function ValidFieldIndex(FieldIndex: Integer): Boolean;
   property EditorMode;
   property FieldCount: Integer read GetFieldCount;
   property Fields[FieldIndex: Integer]: TField read GetFields;
   property SelectedField: TField read GetSelectedField write SetSelectedField;
   property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
   property Vertical: Boolean read FVertical write SetVertical default False;
   property OnlyOne: Boolean read FOnlyOne write SetOnlyOne default False;
   property TitlesWidth: integer read FTitlesWidth write SetTitlesWidth;
  end;

  TVDBGrid = class(TCustomVDBGrid)
  public
   property Canvas;
   property SelectedRows;
  published
   property Align;
   property BorderStyle;
   property Color;
   property Columns stored False; //StoreColumns;
   property Ctl3D;
   property DataSource;
   property DefaultDrawing;
   property DragCursor;
   property DragMode;
   property Enabled;
   property FixedColor;
   property Font;
   property ImeMode;
   property ImeName;
   property Options;
   property ParentColor;
   property ParentCtl3D;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property ReadOnly;
   property ShowHint;
   property TabOrder;
   property TabStop;
   property TitleFont;
   property Visible;
   property Vertical;
   property OnlyOne;
   property DefaultColWidth;
   property TitlesWidth;
   property OnCellClick;
   property OnColEnter;
   property OnColExit;
   property OnColumnMoved;
   property OnDrawDataCell;  { obsolete }
   property OnDrawColumnCell;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEditButtonClick;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnStartDrag;
   property OnTitleClick;
  end;

const
  IndicatorWidth = 11;

procedure Register;

implementation

uses DBConsts, Dialogs;

{$R dbvgrids.res}

procedure Register;
begin
  RegisterComponents('Data Controls',  [ TVDBGrid ]);
//  RegisterPropertyEditor(TypeInfo(TDBGridColumns), TCustomVDBGrid,
//             'Columns', TDBGridColumnsEditor);
end;

const
  bmArrow = 'DBVGARROW';
  bmEdit = 'DBVEDIT';
  bmInsert = 'DBVINSERT';
  bmMultiDot = 'DBVMULTIDOT';
  bmMultiArrow = 'DBVMULTIARROW';

  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }

{ Error reporting }

procedure RaiseGridError(const S: string);
begin
  raise EInvalidGridOperation.Create(S);
end;

procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
  M: TMsg;
begin
  M.Message := 0;
  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
   PostQuitMessage(M.wparam);
end;

{ TVDBGridInplaceEdit }

{ TVDBGridInplaceEdit adds support for a button on the in-place editor,
  which can be used to drop down a table-based lookup list, a stringlist-based
  pick list, or (if button style is esEllipsis) fire the grid event
  OnEditButtonClick.  }

type
  TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
  TPopupListbox = class;

  TVDBGridInplaceEdit = class(TInplaceEdit)
  private
   FButtonWidth: Integer;
   FDataList: TDBLookupListBox;
   FPickList: TPopupListbox;
   FActiveList: TWinControl;
   FLookupSource: TDatasource;
   FEditStyle: TEditStyle;
   FListVisible: Boolean;
   FTracking: Boolean;
   FPressed: Boolean;
   procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
   procedure SetEditStyle(Value: TEditStyle);
   procedure StopTracking;
   procedure TrackButton(X,Y: Integer);
   procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
   procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
   procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
   procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
   procedure WMPaint(var Message: TWMPaint); message wm_Paint;
   procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
  protected
   procedure BoundsChanged; override;
   procedure CloseUp(Accept: Boolean);
   procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
   procedure DropDown;
   procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
   procedure PaintWindow(DC: HDC); override;
   procedure UpdateContents; override;
   procedure WndProc(var Message: TMessage); override;
   property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
   property  ActiveList: TWinControl read FActiveList write FActiveList;
   property  DataList: TDBLookupListBox read FDataList;
   property  PickList: TPopupListbox read FPickList;
  public
   constructor Create(Owner: TComponent); override;
  end;

{ TPopupListbox }

  TPopupListbox = 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;

procedure TPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
   Style := Style or WS_BORDER;
   ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
   WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

procedure TPopupListbox.Keypress(var Key: Char);
var
  TickCount: Integer;
begin
  case Key of
   #8, #27: FSearchText := '';
   #32..#255:
    begin
     TickCount := GetTickCount;
     if TickCount - FSearchTickCount > 2000 then FSearchText := '';
     FSearchTickCount := TickCount;
     if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
     SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
     Key := #0;
    end;
  end;
  inherited Keypress(Key);
end;

procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  TVDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
    (X < Width) and (Y < Height));
end;


constructor TVDBGridInplaceEdit.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  FLookupSource := TDataSource.Create(Self);
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  FEditStyle := esSimple;
end;

procedure TVDBGridInplaceEdit.BoundsChanged;
var
  R: TRect;
begin
  SetRect(R, 2, 2, Width - 2, Height);
  if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  if SysLocale.Fareast then
   SetImeCompositionWindow(Font, R.Left, R.Top);
end;

procedure TVDBGridInplaceEdit.CloseUp(Accept: Boolean);
var
  MasterField: TField;
  ListValue: Variant;
begin
  if FListVisible then
  begin
   if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
   if FActiveList = FDataList then
    ListValue := FDataList.KeyValue
   else
    if FPickList.ItemIndex <> -1 then
     ListValue := FPickList.Items[FPicklist.ItemIndex];
   SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
   FListVisible := False;
   if Assigned(FDataList) then
    FDataList.ListSource := nil;
   FLookupSource.Dataset := nil;
   Invalidate;
   if Accept then
    if FActiveList = FDataList then
     with TCustomVDBGrid(Grid), Columns[SelectedIndex].Field do
     begin
      MasterField := DataSet.FieldByName(KeyFields);
      if MasterField.CanModify then
      begin
       DataSet.Edit;
       MasterField.Value := ListValue;
      end;
     end
    else
     if (not VarIsNull(ListValue)) and EditCanModify then
      with TCustomVDBGrid(Grid), Columns[SelectedIndex].Field do
       Text := ListValue;
  end;
end;

procedure TVDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
begin
  case Key of
   VK_UP, VK_DOWN:
    if ssAlt in Shift then
    begin
     if FListVisible then CloseUp(True) else DropDown;
     Key := 0;
    end;
   VK_RETURN, VK_ESCAPE:
    if FListVisible and not (ssAlt in Shift) then
    begin
     CloseUp(Key = VK_RETURN);
     Key := 0;
    end;
  end;
end;

procedure TVDBGridInplaceEdit.DropDown;
var
  P: TPoint;
  I,J,Y: Integer;
  Column: TColumn;
begin
  if not FListVisible and Assigned(FActiveList) then
  begin
   FActiveList.Width := Width;
   with TCustomVDBGrid(Grid) do
    Column := Columns[SelectedIndex];
   if FActiveList = FDataList then
   with Column.Field do
   begin
    FDataList.Color := Color;
    FDataList.Font := Font;
    FDataList.RowCount := Column.DropDownRows;
    FLookupSource.DataSet := LookupDataSet;
    FDataList.KeyField := LookupKeyFields;
    FDataList.ListField := LookupResultField;
    FDataList.ListSource := FLookupSource;
    FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
{    J := Column.DefaultWidth;
    if J > FDataList.ClientWidth then
     FDataList.ClientWidth := J;
}   end
   else
   begin
    FPickList.Color := Color;
    FPickList.Font := Font;
    FPickList.Items := Column.Picklist;
    if FPickList.Items.Count >= Column.DropDownRows then
     FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
    else
     FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
    if Column.Field.IsNull then
     FPickList.ItemIndex := -1
    else
     FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
    J := FPickList.ClientWidth;
    for I := 0 to FPickList.Items.Count - 1 do
    begin
     Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
     if Y > J then J := Y;
    end;
    FPickList.ClientWidth := J;
   end;
   P := Parent.ClientToScreen(Point(Left, Top));
   Y := P.Y + Height;
   if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
   SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
    SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
   FListVisible := True;
   Invalidate;
   Windows.SetFocus(Handle);
  end;
end;

type
  TWinControlCracker = class(TWinControl) end;

procedure TVDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  begin
   TCustomVDBGrid(Grid).EditButtonClick;
   KillMessage(Handle, WM_CHAR);
  end
  else
   inherited KeyDown(Key, Shift);
end;

procedure TVDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
   CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;

procedure TVDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if (Button = mbLeft) and (FEditStyle <> esSimple) and
   PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
  begin
   if FListVisible then
    CloseUp(False)
   else
   begin
    MouseCapture := True;
    FTracking := True;
    TrackButton(X, Y);
    if Assigned(FActiveList) then
     DropDown;
   end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TVDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ListPos: TPoint;
  MousePos: TSmallPoint;
begin
  if FTracking then
  begin
   TrackButton(X, Y);
   if FListVisible then
   begin
    ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
    if PtInRect(FActiveList.ClientRect, ListPos) then
    begin
     StopTracking;
     MousePos := PointToSmallPoint(ListPos);
     SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
     Exit;
    end;
   end;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TVDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Waspressed: Boolean;
begin
  WasPressed := FPressed;
  StopTracking;
  if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
   TCustomVDBGrid(Grid).EditButtonClick;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TVDBGridInplaceEdit.PaintWindow(DC: HDC);
var
  R: TRect;
  Flags: Integer;
  W: Integer;
begin
  if FEditStyle <> esSimple then
  begin
   SetRect(R, Width - FButtonWidth, 0, Width, Height);
   Flags := 0;
   if FEditStyle in [esDataList, esPickList] then
   begin
    if FActiveList = nil then
     Flags := DFCS_INACTIVE
    else if FPressed then
     Flags := DFCS_FLAT or DFCS_PUSHED;
    DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
   end
   else  { esEllipsis }
   begin
    if FPressed then
     Flags := BF_FLAT;
    DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
    Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
    W := Height shr 3;
    if W = 0 then W := 1;
    PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
    PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
    PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
   end;
   ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
  inherited PaintWindow(DC);
end;

procedure TVDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
  if Value = FEditStyle then Exit;
  FEditStyle := Value;
  case Value of
   esPickList:
    begin
     if FPickList = nil then
     begin
      FPickList := TPopupListbox.Create(Self);
      FPickList.Visible := False;
      FPickList.Parent := Self;
      FPickList.OnMouseUp := ListMouseUp;
      FPickList.IntegralHeight := True;
      FPickList.ItemHeight := 11;
     end;
     FActiveList := FPickList;
    end;
   esDataList:
    begin
     if FDataList = nil then
     begin
      FDataList := TPopupDataList.Create(Self);
      FDataList.Visible := False;
      FDataList.Parent := Self;
      FDataList.OnMouseUp := ListMouseUp;
     end;
     FActiveList := FDataList;
    end;
  else  { cbsNone, cbsEllipsis, or read only field }
   FActiveList := nil;
  end;
  with TCustomVDBGrid(Grid) do
   Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
  Repaint;
end;

procedure TVDBGridInplaceEdit.StopTracking;
begin
  if FTracking then
  begin
   TrackButton(-1, -1);
   FTracking := False;
   MouseCapture := False;
  end;
end;

procedure TVDBGridInplaceEdit.TrackButton(X,Y: Integer);
var
  NewState: Boolean;
  R: TRect;
begin
  SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  NewState := PtInRect(R, Point(X, Y));
  if FPressed <> NewState then
  begin
   FPressed := NewState;
   InvalidateRect(Handle, @R, False);
  end;
end;

procedure TVDBGridInplaceEdit.UpdateContents;
var
  Column: TColumn;
  NewStyle: TEditStyle;
  MasterField: TField;
begin
  with TCustomVDBGrid(Grid) do
   Column := Columns[SelectedIndex];
  NewStyle := esSimple;
  case Column.ButtonStyle of
  cbsEllipsis: NewStyle := esEllipsis;
  cbsAuto:
   if Assigned(Column.Field) then
   with Column.Field do
   begin
    { Show the dropdown button only if the field is editable }
    if FieldKind = fkLookup then
    begin
     MasterField := Dataset.FieldByName(KeyFields);
     { Column.DefaultReadonly will always be True for a lookup field.
      Test if Column.ReadOnly has been assigned a value of True }
     if Assigned(MasterField) and MasterField.CanModify and
      not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
      with TCustomVDBGrid(Grid) do
       if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
        NewStyle := esDataList
    end
    else
    if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
     not Column.Readonly then
     NewStyle := esPickList;
   end;
  end;
  EditStyle := NewStyle;
  inherited UpdateContents;
end;

procedure TVDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
begin
  if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
   CloseUp(False);
end;

procedure TVDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
  StopTracking;
  inherited;
end;

procedure TVDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
  if SysLocale.FarEast then
  begin
   ImeName := Screen.DefaultIme;
   ImeMode := imDontCare;
  end;
  inherited;
  CloseUp(False);
end;

procedure TVDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  with Message do
  if (FEditStyle <> esSimple) and
   PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
   Exit;
  inherited;
end;

procedure TVDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TVDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  if (FEditStyle <> esSimple) and
   PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
   Windows.SetCursor(LoadCursor(0, idc_Arrow))
  else
   inherited;
end;

procedure TVDBGridInplaceEdit.WndProc(var Message: TMessage);
begin
  case Message.Msg of
   wm_KeyDown, wm_SysKeyDown, wm_Char:
    if EditStyle in [esPickList, esDataList] then
    with TWMKey(Message) do
    begin
     DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
     if (CharCode <> 0) and FListVisible then
     begin
      with TMessage(Message) do
       SendMessage(FActiveList.Handle, Msg, WParam, LParam);
      Exit;
     end;
    end
  end;
  inherited;
end;


{ TGridDataLink }

type
  TIntArray = array[0..MaxMapSize] of Integer;
  PIntArray = ^TIntArray;

constructor TGridDataLink.Create(AGrid: TCustomVDBGrid);
begin
  inherited Create;
  FGrid := AGrid;
end;

destructor TGridDataLink.Destroy;
begin
  ClearMapping;
  inherited Destroy;
end;

function TGridDataLink.GetDefaultFields: Boolean;
var
  I: Integer;
begin
  Result := True;
  if DataSet <> nil then Result := DataSet.DefaultFields;
  if Result and SparseMap then
  for I := 0 to FFieldCount-1 do
   if PIntArray(FFieldMap)^[I] < 0 then
   begin
    Result := False;
    Exit;
   end;
end;

function TGridDataLink.GetFields(I: Integer): TField;
begin
  if (0 <= I) and (I < FFieldCount) and (PIntArray(FFieldMap)^[I] >= 0) then
   Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
  else
   Result := nil;
end;

function TGridDataLink.AddMapping(const FieldName: string): Boolean;
var
  Field: TField;
  NewSize: Integer;
begin
  Result := True;
  if FFieldCount >= MaxMapSize then RaiseGridError(STooManyColumns);
  if SparseMap then
   Field := DataSet.FindField(FieldName)
  else
   Field := DataSet.FieldByName(FieldName);

  if FFieldCount = FFieldMapSize then
  begin
   NewSize := FFieldMapSize;
   if NewSize = 0 then
    NewSize := 8
   else
    Inc(NewSize, NewSize);
   if (NewSize < FFieldCount) then
    NewSize := FFieldCount + 1;
   if (NewSize > MaxMapSize) then
    NewSize := MaxMapSize;
   ReallocMem(FFieldMap, NewSize * SizeOf(Integer));
   FFieldMapSize := NewSize;
  end;
  if Assigned(Field) then
  begin
   PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
   Field.FreeNotification(FGrid);
  end
  else
   PIntArray(FFieldMap)^[FFieldCount] := -1;
  Inc(FFieldCount);
end;

procedure TGridDataLink.ActiveChanged;
begin
  FGrid.LinkActive(Active);
end;

procedure TGridDataLink.ClearMapping;
begin
  if FFieldMap <> nil then
  begin
   FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
   FFieldMap := nil;
   FFieldMapSize := 0;
   FFieldCount := 0;
  end;
end;

procedure TGridDataLink.Modified;
begin
  FModified := True;
end;

procedure TGridDataLink.DataSetChanged;
begin
  FGrid.DataChanged;
  FModified := False;
end;

procedure TGridDataLink.DataSetScrolled(Distance: Integer);
begin
  FGrid.Scroll(Distance);
end;

procedure TGridDataLink.LayoutChanged;
var
  SaveState: Boolean;
begin
  { FLayoutFromDataset determines whether default column width is forced to
   be at least wide enough for the column title.  }
  SaveState := FGrid.FLayoutFromDataset;
  FGrid.FLayoutFromDataset := True;
  try
   FGrid.LayoutChanged;
  finally
   FGrid.FLayoutFromDataset := SaveState;
  end;
  inherited LayoutChanged;
end;

procedure TGridDataLink.FocusControl(Field: TFieldRef);
begin
  if Assigned(Field) and Assigned(Field^) then
  begin
   FGrid.SelectedField := Field^;
   if (FGrid.SelectedField = Field^) and FGrid.AcquireFocus then
   begin
    Field^ := nil;
    FGrid.ShowEditor;
   end;
  end;
end;

procedure TGridDataLink.EditingChanged;
begin
  FGrid.EditingChanged;
end;

procedure TGridDataLink.RecordChanged(Field: TField);
begin
  FGrid.RecordChanged(Field);
  FModified := False;
end;

procedure TGridDataLink.UpdateData;
begin
  FInUpdateData := True;
  try
   if FModified then FGrid.UpdateData;
   FModified := False;
  finally
   FInUpdateData := False;
  end;
end;

function TGridDataLink.GetMappedIndex(ColIndex: Integer): Integer;
begin
  if (0 <= ColIndex) and (ColIndex < FFieldCount) then
   Result := PIntArray(FFieldMap)^[ColIndex]
  else
   Result := -1;
end;

procedure TGridDataLink.Reset;
begin
  if FModified then RecordChanged(nil) else Dataset.Cancel;
end;


{ TColumnTitle }
constructor TColumnTitle.Create(Column: TColumn);
begin
  inherited Create;
  FColumn := Column;
  FFont := TFont.Create;
  FFont.Assign(DefaultFont);
  FFont.OnChange := FontChanged;
end;

destructor TColumnTitle.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TColumnTitle.Assign(Source: TPersistent);
begin
  if Source is TColumnTitle then
  begin
   if cvTitleAlignment in TColumnTitle(Source).FColumn.FAssignedValues then
    Alignment := TColumnTitle(Source).Alignment;
   if cvTitleColor in TColumnTitle(Source).FColumn.FAssignedValues then
    Color := TColumnTitle(Source).Color;
   if cvTitleCaption in TColumnTitle(Source).FColumn.FAssignedValues then
    Caption := TColumnTitle(Source).Caption;
   if cvTitleFont in TColumnTitle(Source).FColumn.FAssignedValues then
    Font := TColumnTitle(Source).Font;
  end
  else
   inherited Assign(Source);
end;

function TColumnTitle.DefaultAlignment: TAlignment;
begin
  Result := taLeftJustify;
end;

function TColumnTitle.DefaultColor: TColor;
var
  Grid: TCustomVDBGrid;
begin
  Grid := FColumn.GetGrid;
  if Assigned(Grid) then
   Result := Grid.FixedColor
  else
   Result := clBtnFace;
end;

function TColumnTitle.DefaultFont: TFont;
var
  Grid: TCustomVDBGrid;
begin
  Grid := FColumn.GetGrid;
  if Assigned(Grid) then
   Result := Grid.TitleFont
  else
   Result := FColumn.Font;
end;

function TColumnTitle.DefaultCaption: string;
var
  Field: TField;
begin
  Field := FColumn.Field;
  if Assigned(Field) then
   Result := Field.DisplayName
  else
   Result := FColumn.FieldName;
end;

procedure TColumnTitle.FontChanged(Sender: TObject);
begin
  Include(FColumn.FAssignedValues, cvTitleFont);
  FColumn.Changed(True);
end;

function TColumnTitle.GetAlignment: TAlignment;
begin
  if cvTitleAlignment in FColumn.FAssignedValues then
   Result := FAlignment
  else
   Result := DefaultAlignment;
end;

function TColumnTitle.GetCo

Tags:DBGrid

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接