Fórum DBGrid zebrado #132723

Caro Éder,me mande um e-mail que eu lhe responderei, pois aqui no meu serviço eu não tenho a rotina.
Meu e-mail é eduardo@lpnet.com.br

O exemplo abaixo mostra como deixar cada linha do componente DBGrid de uma cor diferente, dando assim um efeito zebrado. O controle é feito no evento OnDrawColumnCell.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
DBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
If odd(Table1.RecNo) then
begin
DBGrid1.Canvas.Font.Color:= clWhite;
DBGrid1.Canvas.Brush.Color:= clGreen;
end
else
begin
DBGrid1.Canvas.Font.Color:= clBlack;
DBGrid1.Canvas.Brush.Color:= clWhite;
end;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.Canvas.TextOut(Rect.Left+2,Rect.Top,Column.Field.AsString);
end;

Falow

Não funciona este código acima!

TB pode tentar alterar o Arquivo dbgrid.pas

eu fiz umas alteraçõezinhas vê se ajuda.

obs. Procure a propriedade ninocolor1 ou ninocolor2. Ou
instale este arquivo na sua pasta que funciona.

Espero que ajude!!!!

{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ }
{ Copyright (c) 1995,98 Inprise Corporation }
{ wsd }
{*******************************************************}

unit DBGrids;

{$R-}

interface

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

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. If IsStored is
True, 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.

If IsStored is True, the column does not maintain local storage of
property values. Assignments to column properties are passed through to
the underlying grid- or field-based default sources. }
type
TColumn = class;
TCustomDBGrid = 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;
property Column: TColumn read FColumn;
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;
FVisible: Boolean;
FExpanded: Boolean;
FStored: Boolean;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
function GetColor: TColor;
function GetExpanded: Boolean;
function GetField: TField;
function GetFont: TFont;
function GetImeMode: TImeMode;
function GetImeName: TImeName;
function GetParentColumn: TColumn;
function GetPickList: TStrings;
function GetReadOnly: Boolean;
function GetShowing: Boolean;
function GetWidth: Integer;
function GetVisible: Boolean;
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 SetExpanded(Value: Boolean);
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;
procedure SetVisible(Value: Boolean);
function GetExpandable: Boolean;
protected
function CreateTitle: TColumnTitle; virtual;
function GetGrid: TCustomDBGrid;
function GetDisplayName: string; override;
procedure RefreshDefaultFont;
procedure SetIndex(Value: Integer); override;
property IsStored: Boolean read FStored write FStored default True;
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;
function Depth: Integer;
procedure RestoreDefaults; virtual;
property Grid: TCustomDBGrid read GetGrid;
property AssignedValues: TColumnValues read FAssignedValues;
property Expandable: Boolean read GetExpandable;
property Field: TField read GetField write SetField;
property ParentColumn: TColumn read GetParentColumn;
property Showing: Boolean read GetShowing;
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 Expanded: Boolean read GetExpanded write SetExpanded default True;
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;
property Visible: Boolean read GetVisible write SetVisible;
end;

TColumnClass = class of TColumn;

TDBGridColumnsState = (csDefault, csCustomized);

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

TGridDataLink = class(TDataLink)
private
FGrid: TCustomDBGrid;
FFieldCount: Integer;
FFieldMap: array of Integer;
FModified: Boolean;
FInUpdateData: Boolean;
FSparseMap: Boolean;
function GetDefaultFields: Boolean;
function GetFields(I: Integer): TField;
protected
procedure ActiveChanged; override;
procedure BuildAggMap;
procedure DataSetChanged; override;
procedure DataSetScrolled(Distance: Integer); override;
procedure FocusControl(Field: TFieldRef); override;
procedure EditingChanged; override;
function IsAggRow(Value: Integer): Boolean; virtual;
procedure LayoutChanged; override;
procedure RecordChanged(Field: TField); override;
procedure UpdateData; override;
function GetMappedIndex(ColIndex: Integer): Integer;
public
constructor Create(AGrid: TCustomDBGrid);
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: TCustomDBGrid;
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: TCustomDBGrid);
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 DBGrid´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 DBGrid´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;

TCustomDBGrid = class(TCustomGrid)
private
FIndicators: TImageList;
FTitleFont: TFont;
FReadOnly: Boolean;
FOriginalImeName: TImeName;
FOriginalImeMode: TImeMode;
FUserChange: Boolean;
FIsESCKey: 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;
FVisibleColumns: TList;
FBookmarks: TBookmarkList;
FSelectionAnchor: TBookmarkStr;
FOnEditButtonClick: TNotifyEvent;
FOnColumnMoved: TMovedEvent;
FOnCellClick: TDBGridClickEvent;
FOnTitleClick:TDBGridClickEvent;
FDragCol: TColumn;
FNinoColor1: TColor;
FNinoColor2: TColor;


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, Direction: Integer);
function PtInExpandButton(X,Y: Integer; var MasterCol: TColumn): Boolean;
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 CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
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 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;
function RawToDataColumn(ACol: Integer): Integer;
function DataToRawColumn(ACol: Integer): Integer;
function AcquireLayoutLock: Boolean;
procedure BeginLayout;
procedure BeginUpdate;
procedure CalcSizingState(X, Y: Integer; var State: TGridState;
var Index: Longint; var SizingPos, SizingOfs: Integer;
var FixedInfo: TGridDrawInfo); override;
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;
function CalcTitleRect(Col: TColumn; ARow: Integer;
var MasterCol: TColumn): TRect;
function ColumnAtDepth(Col: TColumn; ADepth: Integer): TColumn;
procedure ColEnter; dynamic;
procedure ColExit; dynamic;
procedure ColWidthsChanged; override;
function CreateColumns: TDBGridColumns; dynamic;
function CreateEditor: TInplaceEdit; override;
procedure CreateWnd; override;
procedure DeferLayout;
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 InvalidateTitles;
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;
procedure TopLeftChanged; override;
function UseRightToLeftAlignmentForField(const AField: TField;
Alignment: TAlignment): Boolean;
function BeginColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; override;
function CheckColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; override;
function EndColumnDrag(var Origin, Destination: Integer;
const MousePt: TPoint): Boolean; override;
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);
procedure DefaultHandler(var Msg); override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
procedure ShowPopupEditor(Column: TColumn; X: Integer = Low(Integer);
Y: Integer = Low(Integer)); dynamic;
function UpdateAction(Action: TBasicAction): Boolean; override;
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 NinoColor1: TColor read FNinoColor1 write FNinoColor1;
property NinoColor2: TColor read FNinoColor2 write FNinoColor2;
end;

TDBGrid = class(TCustomDBGrid)
public
property Canvas;
property SelectedRows;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns stored False; //StoreColumns;
property Constraints;
property Ctl3D;
property DataSource;
property DefaultDrawing;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property Font;
property ImeMode;
property ImeName;
property Options;
property NinoColor1;
property NinoColor2;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property TitleFont;
property Visible;
property OnCellClick;
property OnColEnter;
property OnColExit;
property OnColumnMoved;
property OnDrawDataCell; { obsolete }
property OnDrawColumnCell;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditButtonClick;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnStartDock;
property OnStartDrag;
property OnTitleClick;

end;

const
IndicatorWidth = 11;

implementation

uses Math, DBConsts, Dialogs;

{$R DBGRIDS.RES}

const
bmArrow = ´DBGARROW´;
bmEdit = ´DBEDIT´;
bmInsert = ´DBINSERT´;
bmMultiDot = ´DBMULTIDOT´;
bmMultiArrow = ´DBMULTIARROW´;

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;

{ TDBGridInplaceEdit }

{ TDBGridInplaceEdit 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;

TDBGridInplaceEdit = 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;
function OverButton(const P: TPoint): Boolean;
function ButtonRect: TRect;
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;
AddBiDiModeExStyle(ExStyle);
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);
TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
(X < Width) and (Y < Height));
end;


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

procedure TDBGridInplaceEdit.BoundsChanged;
var
R: TRect;
begin
SetRect(R, 2, 2, Width - 2, Height);
if FEditStyle <> esSimple then
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Dec(R.Right, FButtonWidth)
else
Inc(R.Left, FButtonWidth - 2);
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 TDBGridInplaceEdit.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 TCustomDBGrid(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 TCustomDBGrid(Grid), Columns[SelectedIndex].Field do
Text := ListValue;
end;
end;

procedure TDBGridInplaceEdit.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 TDBGridInplaceEdit.DropDown;
var
P: TPoint;
I,J,Y: Integer;
Column: TColumn;
begin
if not FListVisible and Assigned(FActiveList) then
begin
FActiveList.Width := Width;
with TCustomDBGrid(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 >= Integer(Column.DropDownRows) then
FPickList.Height := Integer(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.Text);
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 TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
begin
TCustomDBGrid(Grid).EditButtonClick;
KillMessage(Handle, WM_CHAR);
end
else
inherited KeyDown(Key, Shift);
end;

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

procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if (Button = mbLeft) and (FEditStyle <> esSimple) and
OverButton(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 TDBGridInplaceEdit.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 TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
WasPressed: Boolean;
begin
WasPressed := FPressed;
StopTracking;
if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
TCustomDBGrid(Grid).EditButtonClick;
inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
var
R: TRect;
Flags: Integer;
W, X, Y: Integer;
begin
if FEditStyle <> esSimple then
begin
R := ButtonRect;
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);
X := R.Left + ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
Y := R.Top + ((R.Bottom - R.Top) shr 1) - 1 + Ord(FPressed);
W := FButtonWidth shr 3;
if W = 0 then W := 1;
PatBlt(DC, X, Y, W, W, BLACKNESS);
PatBlt(DC, X - (W * 2), Y, W, W, BLACKNESS);
PatBlt(DC, X + (W * 2), Y, W, W, BLACKNESS);
end;
ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
end;
inherited PaintWindow(DC);
end;

procedure TDBGridInplaceEdit.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 TCustomDBGrid(Grid) do
Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
Repaint;
end;

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

procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
var
NewState: Boolean;
R: TRect;
begin
R := ButtonRect;
NewState := PtInRect(R, Point(X, Y));
if FPressed <> NewState then
begin
FPressed := NewState;
InvalidateRect(Handle, @R, False);
end;
end;

procedure TDBGridInplaceEdit.UpdateContents;
var
Column: TColumn;
NewStyle: TEditStyle;
MasterField: TField;
begin
with TCustomDBGrid(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 TCustomDBGrid(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
else if DataType in [ftDataset, ftReference] then
NewStyle := esEllipsis;
end;
end;
EditStyle := NewStyle;
inherited UpdateContents;
Font.Assign(Column.Font);
end;

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

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

procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
if not SysLocale.FarEast then inherited
else
begin
ImeName := Screen.DefaultIme;
ImeMode := imDontCare;
inherited;
if HWND(Message.WParam) <> TCustomDBGrid(Grid).Handle then
ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
end;
CloseUp(False);
end;

function TDBGridInplaceEdit.ButtonRect: TRect;
begin
if not TCustomDBGrid(Owner).UseRightToLeftAlignment then
Result := Rect(Width - FButtonWidth, 0, Width, Height)
else
Result := Rect(0, 0, FButtonWidth, Height);
end;

function TDBGridInplaceEdit.OverButton(const P: TPoint): Boolean;
begin
Result := PtInRect(ButtonRect, P);
end;

procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
with Message do
if (FEditStyle <> esSimple) and OverButton(Point(XPos, YPos)) then
Exit;
inherited;
end;

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

procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (FEditStyle <> esSimple) and OverButton(P) then
Windows.SetCursor(LoadCursor(0, idc_Arrow))
else
inherited;
end;

procedure TDBGridInplaceEdit.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: TCustomDBGrid);
begin
inherited Create;
FGrid := AGrid;
VisualControl := True;
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 FFieldMap[I] < 0 then
begin
Result := False;
Exit;
end;
end;

function TGridDataLink.GetFields(I: Integer): TField;
begin
if (0 <= I) and (I < FFieldCount) and (FFieldMap[I] >= 0) then
Result := DataSet.FieldList[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 = Length(FFieldMap) then
begin
NewSize := Length(FFieldMap);
if NewSize = 0 then
NewSize := 8
else
Inc(NewSize, NewSize);
if (NewSize < FFieldCount) then
NewSize := FFieldCount + 1;
if (NewSize > MaxMapSize) then
NewSize := MaxMapSize;
SetLength(FFieldMap, NewSize);
end;
if Assigned(Field) then
begin
FFieldMap[FFieldCount] := Dataset.FieldList.IndexOfObject(Field);
Field.FreeNotification(FGrid);
end
else
FFieldMap[FFieldCount] := -1;
Inc(FFieldCount);
end;

procedure TGridDataLink.ActiveChanged;
begin
FGrid.LinkActive(Active);
FModified := False;
end;

procedure TGridDataLink.ClearMapping;
begin
FFieldMap := nil;
FFieldCount := 0;
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 := FFieldMap[ColIndex]
else
Result := -1;
end;

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

function TGridDataLink.IsAggRow(Value: Integer): Boolean;
begin
Result := False;
end;

procedure TGridDataLink.BuildAggMap;
begin
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: TCustomDBGrid;
begin
Grid := FColumn.GetGrid;
if Assigned(Grid) then
Result := Grid.FixedColor
else
Result := clBtnFace;
end;

function TColumnTitle.DefaultFont: TFont;
var
Grid: TCustomDBGrid;
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.GetColor: TColor;
begin
if cvTitleColor in FColumn.FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;

function TColumnTitle.GetCaption: string;
begin
if cvTitleCaption in FColumn.FAssignedValues then
Result := FCaption
else
Result := DefaultCaption;
end;

function TColumnTitle.GetFont: TFont;
var
Save: TNotifyEvent;
Def: TFont;
begin
if not (cvTitleFont in FColumn.FAssignedValues) then
begin
Def := DefaultFont;
if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
end;
Result := FFont;
end;

function TColumnTitle.IsAlignmentStored: Boolean;
begin
Result := (cvTitleAlignment in FColumn.FAssignedValues) and
(FAlignment <> DefaultAlignment);
end;

function TColumnTitle.IsColorStored: Boolean;
begin
Result := (cvTitleColor in FColumn.FAssignedValues) and
(FColor <> DefaultColor);
end;

function TColumnTitle.IsFontStored: Boolean;
begin
Result := (cvTitleFont in FColumn.FAssignedValues);
end;

function TColumnTitle.IsCaptionStored: Boolean;
begin
Result := (cvTitleCaption in FColumn.FAssignedValues) and
(FCaption <> DefaultCaption);
end;

procedure TColumnTitle.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if (cvTitleFont in FColumn.FAssignedValues) then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;

procedure TColumnTitle.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvTitleFont in FColumn.FAssignedValues;
FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
FCaption := ´´;
RefreshDefaultFont;
{ If font was assigned, changing it back to default may affect grid title
height, and title height changes require layout and redraw of the grid. }
FColumn.Changed(FontAssigned);
end;

procedure TColumnTitle.SetAlignment(Value: TAlignment);
begin
if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FColumn.FAssignedValues, cvTitleAlignment);
FColumn.Changed(False);
end;

procedure TColumnTitle.SetColor(Value: TColor);
begin
if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FColumn.FAssignedValues, cvTitleColor);
FColumn.Changed(False);
end;

procedure TColumnTitle.SetFont(Value: TFont);
begin
FFont.Assign(Value);
end;

procedure TColumnTitle.SetCaption(const Value: string);
var
Grid: TCustomDBGrid;
begin
if Column.IsStored then
begin
if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
FCaption := Value;
Include(Column.FAssignedValues, cvTitleCaption);
Column.Changed(False);
end
else
begin
Grid := Column.GetGrid;
if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(Column.Field) then
Column.Field.DisplayLabel := Value;
end;
end;


{ TColumn }

constructor TColumn.Create(Collection: TCollection);
var
Grid: TCustomDBGrid;
begin
Grid := nil;
if Assigned(Collection) and (Collection is TDBGridColumns) then
Grid := TDBGridColumns(Collection).Grid;
if Assigned(Grid) then Grid.BeginLayout;
try
inherited Create(Collection);
FDropDownRows := 7;
FButtonStyle := cbsAuto;
FFont := TFont.Create;
FFont.Assign(DefaultFont);
FFont.OnChange := FontChanged;
FImeMode := imDontCare;
FImeName := Screen.DefaultIme;
FTitle := CreateTitle;
FVisible := True;
FExpanded := True;
FStored := True;
finally
if Assigned(Grid) then Grid.EndLayout;
end;
end;

destructor TColumn.Destroy;
begin
FTitle.Free;
FFont.Free;
FPickList.Free;
inherited Destroy;
end;

procedure TColumn.Assign(Source: TPersistent);
begin
if Source is TColumn then
begin
if Assigned(Collection) then Collection.BeginUpdate;
try
RestoreDefaults;
FieldName := TColumn(Source).FieldName;
if cvColor in TColumn(Source).AssignedValues then
Color := TColumn(Source).Color;
if cvWidth in TColumn(Source).AssignedValues then
Width := TColumn(Source).Width;
if cvFont in TColumn(Source).AssignedValues then
Font := TColumn(Source).Font;
if cvImeMode in TColumn(Source).AssignedValues then
ImeMode := TColumn(Source).ImeMode;
if cvImeName in TColumn(Source).AssignedValues then
ImeName := TColumn(Source).ImeName;
if cvAlignment in TColumn(Source).AssignedValues then
Alignment := TColumn(Source).Alignment;
if cvReadOnly in TColumn(Source).AssignedValues then
ReadOnly := TColumn(Source).ReadOnly;
Title := TColumn(Source).Title;
DropDownRows := TColumn(Source).DropDownRows;
ButtonStyle := TColumn(Source).ButtonStyle;
PickList := TColumn(Source).PickList;
PopupMenu := TColumn(Source).PopupMenu;
FVisible := TColumn(Source).FVisible;
FExpanded := TColumn(Source).FExpanded;
finally
if Assigned(Collection) then Collection.EndUpdate;
end;
end
else
inherited Assign(Source);
end;

function TColumn.CreateTitle: TColumnTitle;
begin
Result := TColumnTitle.Create(Self);
end;

function TColumn.DefaultAlignment: TAlignment;
begin
if Assigned(Field) then
Result := FField.Alignment
else
Result := taLeftJustify;
end;

function TColumn.DefaultColor: TColor;
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Color
else
Result := clWindow;
end;

function TColumn.DefaultFont: TFont;
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.Font
else
Result := FFont;
end;

function TColumn.DefaultImeMode: TImeMode;
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeMode
else
Result := FImeMode;
end;

function TColumn.DefaultImeName: TImeName;
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
if Assigned(Grid) then
Result := Grid.ImeName
else
Result := FImeName;
end;

function TColumn.DefaultReadOnly: Boolean;
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
Result := (Assigned(Grid) and Grid.ReadOnly) or
(Assigned(Field) and FField.ReadOnly);
end;

function TColumn.DefaultWidth: Integer;
var
W: Integer;
RestoreCanvas: Boolean;
TM: TTextMetric;
begin
if GetGrid = nil then
begin
Result := 64;
Exit;
end;
with GetGrid do
begin
if Assigned(Field) then
begin
RestoreCanvas := not HandleAllocated;
if RestoreCanvas then
Canvas.Handle := GetDC(0);
try
Canvas.Font := Self.Font;
GetTextMetrics(Canvas.Handle, TM);
Result := Field.DisplayWidth * (Canvas.TextWidth(´0´) - TM.tmOverhang)
+ TM.tmOverhang + 4;
if dgTitles in Options then
begin
Canvas.Font := Title.Font;
W := Canvas.TextWidth(Title.Caption) + 4;
if Result < W then
Result := W;
end;
finally
if RestoreCanvas then
begin
ReleaseDC(0,Canvas.Handle);
Canvas.Handle := 0;
end;
end;
end
else
Result := DefaultColWidth;
end;
end;

procedure TColumn.FontChanged;
begin
Include(FAssignedValues, cvFont);
Title.RefreshDefaultFont;
Changed(False);
end;

function TColumn.GetAlignment: TAlignment;
begin
if cvAlignment in FAssignedValues then
Result := FAlignment
else
Result := DefaultAlignment;
end;

function TColumn.GetColor: TColor;
begin
if cvColor in FAssignedValues then
Result := FColor
else
Result := DefaultColor;
end;

function TColumn.GetExpanded: Boolean;
begin
Result := FExpanded and Expandable;
end;

function TColumn.GetField: TField;
var
Grid: TCustomDBGrid;
begin { Returns Nil if FieldName can´t be found in dataset }
Grid := GetGrid;
if (FField = nil) and (Length(FFieldName) > 0) and Assigned(Grid) and
Assigned(Grid.DataLink.DataSet) then
with Grid.Datalink.Dataset do
if Active or (not DefaultFields) then
SetField(FindField(FieldName));
Result := FField;
end;

function TColumn.GetFont: TFont;
var
Save: TNotifyEvent;
begin
if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
begin
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
end;
Result := FFont;
end;

function TColumn.GetGrid: TCustomDBGrid;
begin
if Assigned(Collection) and (Collection is TDBGridColumns) then
Result := TDBGridColumns(Collection).Grid
else
Result := nil;
end;

function TColumn.GetDisplayName: string;
begin
Result := FFieldName;
if Result = ´´ then Result := inherited GetDisplayName;
end;

function TColumn.GetImeMode: TImeMode;
begin
if cvImeMode in FAssignedValues then
Result := FImeMode
else
Result := DefaultImeMode;
end;

function TColumn.GetImeName: TImeName;
begin
if cvImeName in FAssignedValues then
Result := FImeName
else
Result := DefaultImeName;
end;

function TColumn.GetParentColumn: TColumn;
var
Col: TColumn;
Fld: TField;
I: Integer;
begin
Result := nil;
Fld := Field;
if (Fld <> nil) and (Fld.ParentField <> nil) and (Collection <> nil) then
for I := Index - 1 downto 0 do
begin
Col := TColumn(Collection.Items[I]);
if Fld.ParentField = Col.Field then
begin
Result := Col;
Exit;
end;
end;
end;

function TColumn.GetPickList: TStrings;
begin
if FPickList = nil then
FPickList := TStringList.Create;
Result := FPickList;
end;

function TColumn.GetReadOnly: Boolean;
begin
if cvReadOnly in FAssignedValues then
Result := FReadOnly
else
Result := DefaultReadOnly;
end;

function TColumn.GetShowing: Boolean;
var
Col: TColumn;
begin
Result := not Expanded and Visible;
if Result then
begin
Col := Self;
repeat
Col := Col.ParentColumn;
until (Col = nil) or not Col.Expanded;
Result := Col = nil;
end;
end;

function TColumn.GetVisible: Boolean;
var
Col: TColumn;
begin
Result := FVisible;
if Result then
begin
Col := ParentColumn;
Result := Result and ((Col = nil) or Col.Visible);
end;
end;

function TColumn.GetWidth: Integer;
begin
if not Showing then
Result := -1
else if cvWidth in FAssignedValues then
Result := FWidth
else
Result := DefaultWidth;
end;

function TColumn.IsAlignmentStored: Boolean;
begin
Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
end;

function TColumn.IsColorStored: Boolean;
begin
Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
end;

function TColumn.IsFontStored: Boolean;
begin
Result := (cvFont in FAssignedValues);
end;

function TColumn.IsImeModeStored: Boolean;
begin
Result := (cvImeMode in FAssignedValues) and (FImeMode <> DefaultImeMode);
end;

function TColumn.IsImeNameStored: Boolean;
begin
Result := (cvImeName in FAssignedValues) and (FImeName <> DefaultImeName);
end;

function TColumn.IsReadOnlyStored: Boolean;
begin
Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> DefaultReadOnly);
end;

function TColumn.IsWidthStored: Boolean;
begin
Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
end;

procedure TColumn.RefreshDefaultFont;
var
Save: TNotifyEvent;
begin
if cvFont in FAssignedValues then Exit;
Save := FFont.OnChange;
FFont.OnChange := nil;
try
FFont.Assign(DefaultFont);
finally
FFont.OnChange := Save;
end;
end;

procedure TColumn.RestoreDefaults;
var
FontAssigned: Boolean;
begin
FontAssigned := cvFont in FAssignedValues;
FTitle.RestoreDefaults;
FAssignedValues := [];
RefreshDefaultFont;
FPickList.Free;
FPickList := nil;
ButtonStyle := cbsAuto;
Changed(FontAssigned);
end;

procedure TColumn.SetAlignment(Value: TAlignment);
var
Grid: TCustomDBGrid;
begin
if IsStored then
begin
if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
FAlignment := Value;
Include(FAssignedValues, cvAlignment);
Changed(False);
end
else
begin
Grid := GetGrid;
if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(Field) then
Field.Alignment := Value;
end;
end;

procedure TColumn.SetButtonStyle(Value: TColumnButtonStyle);
begin
if Value = FButtonStyle then Exit;
FButtonStyle := Value;
Changed(False);
end;

procedure TColumn.SetColor(Value: TColor);
begin
if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
FColor := Value;
Include(FAssignedValues, cvColor);
Changed(False);
end;

procedure TColumn.SetField(Value: TField);
begin
if FField = Value then Exit;
FField := Value;
if Assigned(Value) then
FFieldName := Value.FullName;
if not IsStored then
begin
if Value = nil then
FFieldName := ´´;
RestoreDefaults;
end;
Changed(False);
end;

procedure TColumn.SetFieldName(const Value: String);
var
AField: TField;
Grid: TCustomDBGrid;
begin
AField := nil;
Grid := GetGrid;
if Assigned(Grid) and Assigned(Grid.DataLink.DataSet) and
not (csLoading in Grid.ComponentState) and (Length(Value) > 0) then
AField := Grid.DataLink.DataSet.FindField(Value); { no exceptions }
FFieldName := Value;
SetField(AField);
Changed(False);
end;

procedure TColumn.SetFont(Value: TFont);
begin
FFont.Assign(Value);
Include(FAssignedValues, cvFont);
Changed(False);
end;

procedure TColumn.SetImeMode(Value: TImeMode);
begin
if (cvImeMode in FAssignedValues) or (Value <> DefaultImeMode) then
begin
FImeMode := Value;
Include(FAssignedValues, cvImeMode);
end;
Changed(False);
end;

procedure TColumn.SetImeName(Value: TImeName);
begin
if (cvImeName in FAssignedValues) or (Value <> DefaultImeName) then
begin
FImeName := Value;
Include(FAssignedValues, cvImeName);
end;
Changed(False);
end;

procedure TColumn.SetIndex(Value: Integer);
var
Grid: TCustomDBGrid;
Fld: TField;
I, OldIndex: Integer;
Col: TColumn;
begin
OldIndex := Index;
Grid := GetGrid;

if IsStored then
begin
Grid.BeginLayout;
try
I := OldIndex + 1; // move child columns along with parent
while (I < Collection.Count) and (TColumn(Collection.Items[I]).ParentColumn = Self) do
Inc(I);
Dec(I);
if OldIndex > Value then // column moving left
begin
while I > OldIndex do
begin
Collection.Items[I].Index := Value;
Inc(OldIndex);
end;
inherited SetIndex(Value);
end
else
begin
inherited SetIndex(Value);
while I > OldIndex do
begin
Collection.Items[OldIndex].Index := Value;
Dec(I);
end;
end;
finally
Grid.EndLayout;
end;
end
else
begin
if (Grid <> nil) and Grid.Datalink.Active then
begin
if Grid.AcquireLayoutLock then
try
Col := Grid.ColumnAtDepth(Grid.Columns[Value], Depth);
if (Col <> nil) then
begin
Fld := Col.Field;
if Assigned(Fld) then
Field.Index := Fld.Index;
end;
finally
Grid.EndLayout;
end;
end;
inherited SetIndex(Value);
end;
end;

procedure TColumn.SetPickList(Value: TStrings);
begin
if Value = nil then
begin
FPickList.Free;
FPickList := nil;
Exit;
end;
PickList.Assign(Value);
end;

procedure TColumn.SetPopupMenu(Value: TPopupMenu);
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(GetGrid);
end;

procedure TColumn.SetReadOnly(Value: Boolean);
var
Grid: TCustomDBGrid;
begin
Grid := GetGrid;
if not IsStored and Assigned(Grid) and Grid.Datalink.Active and Assigned(Field) then
Field.ReadOnly := Value
else
begin
if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
FReadOnly := Value;
Include(FAssignedValues, cvReadOnly);
Changed(False);
end;
end;

procedure TColumn.SetTitle(Value: TColumnTitle);
begin
FTitle.Assign(Value);
end;

procedure TColumn.SetWidth(Value: Integer);
var
Grid: TCustomDBGrid;
TM: TTextMetric;
DoSetWidth: Boolean;
begin
DoSetWidth := IsStored;
if not DoSetWidth then
begin
Grid := GetGrid;
if Assigned(Grid) then
begin
if Grid.HandleAllocated and Assigned(Field) and Grid.FUpdateFields then
with Grid do
begin
Canvas.Font := Self.Font;
GetTextMetrics(Canvas.Handle, TM);
Field.DisplayWidth := (Value + (TM.tmAveCharWidth div 2) - TM.tmOverhang - 3)
div TM.tmAveCharWidth;
end;
if (not Grid.FLayoutFromDataset) or (cvWidth in FAssignedValues) then
DoSetWidth := True;
end
else
DoSetWidth := True;
end;
if DoSetWidth then
begin
if ((cvWidth in FAssignedValues) or (Value <> DefaultWidth))
and (Value <> -1) then
begin
FWidth := Value;
Include(FAssignedValues, cvWidth);
end;
Chang

o arquivo foi cortado pela metade... se quiser te mando por e-mail!

Amigo Hoje eu estou Usando uma funcao e esta rodando bem

se puder ser util ai esta.

No evento onDrawColumnCell do Dbgrid coloque esta funcao

If Not Odd(SuaTQuery.Recno) then Begin
If Not (GDselected in state) Then Begin
DBgrid.canvas.Brush.color := ClBlue ( Cor Desejada );
DBgrid.canvas.fillrect(rect);
DBgrid.defaultDrawDataCell(Rect,Column.Field,State);
end;
End;

Espero ter ajudado :shock:

como conseguir que o texto no campo fique centralizado?