DBGrid的實用技巧

1.隔行不同顏色顯示
with TDBGrid(Sender) do
begin
if (gdSelected in State) or (gdFocused in State) then
Canvas.Brush.Color := clAqua
else if DataSource.DataSet.RecNo mod 2 = 0 then
Canvas.Brush.Color := $00F0F0F5
else
Canvas.Brush.Color := clWindow;
DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

2.Flat風格
屬性設置：
Ctrl3D = False
Options.dgColLines = False
Options.dgRowLines = False

type
TGridAccess = class(TCustomGrid);

Form.OnCreate：
with TGridAccess(DBGrid1) do
Options := Options + [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine];

3.去掉滾動條
private
{ Private declarations }
FGridWndProc: TWndMethod;
procedure GridWndProc(var Message: TMessage);

Form.OnCreate：
TGridAccess(DBGrid1).ScrollBars := ssNone;
FGridWndProc := DBGrid1.WindowProc;
DBGrid1.WindowProc := GridWndProc;

Form.OnDestroy：
DBGrid1.WindowProc := FGridWndProc;

procedure TForm1.GridWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_PAINT, WM_NCPAINT:
begin
SetScrollRange(DBGrid1.Handle, SB_HORZ, 0, 0, False);
SetScrollRange(DBGrid1.Handle, SB_VERT, 0, 0, False);
end;
end;
FGridWndProc(Message);
end;

4.鼠標移到某個單元格，指針形狀改變
procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Coord: TGridCoord;
begin
Coord := TDBGrid(Sender).MouseCoord(X, Y);
if (Coord.Y > 0) and (Coord.X = 1) and not TDBGrid(Sender).DataSource.DataSet.IsEmpty then
begin // Coord.X=1，dgIndicator=True時說明在第一列，False時說明在第二列
TDBGrid(Sender).Cursor := crHandPoint;
StatusBar1.SimpleText := 'Click to open curve form';
end
else
begin
TDBGrid(Sender).Cursor := crDefault;
StatusBar1.SimpleText := '';
end;
end;

5.Options.dgRowSelect=True時，點擊不同單元格列，執行不同的動作
DBGrid的OnMouseDown/OnMouseUp事件在點擊記錄單元格時不會觸發(點擊固定行列區會觸發)，而Options.dgRowSelect=True時，OnCellClick事件的Column總是傳遞第一個列對象，即Column.Index=0，即使你點擊的是其他列，因此需要在OnCellClick中再判斷點擊的是哪個列，再根據不同列執行不同的動作。
procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
Coord: TGridCoord;
P: TPoint;
begin
GetCursorPos(P);
Windows.ScreenToClient(TDBGrid(Sender).Handle, P);
Coord := TDBGrid(Sender).MouseCoord(P.X, P.Y);
if (Coord.Y > 0) and (Coord.X = 1) and not TDBGrid(Sender).DataSource.DataSet.IsEmpty then
// Coord.X=1，dgIndicator=True時說明在第一列，False時說明在第二列
ShowMessage(GridRate.Columns[0].Field.AsString);
end;



2006-1-5 15:50:45
查看評語»»»

2006-1-5 16:57:15 6.支持鼠標滾輪方法一：
private
{ Private declarations }
procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

Form.OnCreate：
TControlAccess(DBGrid1).OnMouseWheel := GridMouseWheel;

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
TDBGrid(Sender).DataSource.DataSet.MoveBy(-WheelDelta div WHEEL_DELTA);
Handled := True;
end;

方法二：
private
{ Private declarations }
FGridWndProc: TWndMethod;
procedure GridWndProc(var Message: TMessage);

Form.OnCreate：
FGridWndProc := DBGrid1.WindowProc;
DBGrid1.WindowProc := GridWndProc;

Form.OnDestroy：
DBGrid1.WindowProc := FGridWndProc;

procedure TForm1.GridWndProc(var Message: TMessage);
begin
case Message.Msg of
WM_MOUSEWHEEL:
begin
DBGrid1.DataSource.DataSet.MoveBy(-Smallint(Message.WParamHi) div WHEEL_DELTA);
end;
else FGridWndProc(Message);
end;
end;


2006-1-5 16:59:05 6.支持鼠標滾輪(補充)type
TControlAccess = class(TControl);


2006-1-17 10:39:50 隔行不同顏色顯示(2)鑑於DataSource.DataSet.RecNo可能無效，改用DataLink.ActiveRecord。

type
TDBGridAccess = class(TCustomDBGrid);

procedure TForm1.GridListDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
with TDBGrid(Sender) do
begin
Canvas.Font.Color := clBlack;
if (gdSelected in State) or (gdFocused in State) then
Canvas.Brush.Color := clAqua
else if Odd(TDBGridAccess(Sender).DataLink.ActiveRecord) then
Canvas.Brush.Color := $00F0F0F5
else
Canvas.Brush.Color := clWindow;

DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;


2006-1-17 14:48:45 7.顯示行號unit HackGrid;

interface

uses Windows, SysUtils, Grids, DBGrids;

type
THackGrid = class
protected
class procedure NewSetColumnAttributes;
public
class procedure Hook(AIndicatorWidth: Integer);
class procedure Unhook;
class procedure DrawOrds(Sender: TObject; AState: TGridDrawState);
end;

implementation

var
GOldSetColumnAttributes: Pointer;
GIndicatorWidth: Integer;

type
TDBGridAccess = class(TCustomDBGrid);

{ THackGrid }

class procedure THackGrid.Hook(AIndicatorWidth: Integer);
var
obj: TObject;
vmt, vmtIndex: Integer;
method, newMethod: Pointer;
dwOldProtect: DWORD;
begin
GIndicatorWidth := AIndicatorWidth;
if GOldSetColumnAttributes <> nil then Exit;

obj := TDBGrid.Create(nil);
try
vmt := PInteger(obj)^;
asm
MOV vmtIndex,VMTOFFSET TDBGridAccess.SetColumnAttributes;
end;
method := Pointer(vmt + vmtIndex);
GOldSetColumnAttributes := PPointer(method)^;

VirtualProtect(method, 4, PAGE_READWRITE, dwOldProtect);
newMethod := @THackGrid.NewSetColumnAttributes;
PPointer(method)^ := newMethod;
VirtualProtect(method, 4, dwOldProtect, dwOldProtect);
finally
obj.Free;
end;
end;

class procedure THackGrid.Unhook;
var
obj: TObject;
vmt, vmtIndex: Integer;
method: Pointer;
dwOldProtect: DWORD;
begin
if GOldSetColumnAttributes = nil then Exit;

obj := TDBGrid.Create(nil);
try
vmt := PInteger(obj)^;
asm
MOV vmtIndex,VMTOFFSET TDBGridAccess.SetColumnAttributes;
end;
method := Pointer(vmt + vmtIndex);

VirtualProtect(method, 4, PAGE_READWRITE, dwOldProtect);
PPointer(method)^ := GOldSetColumnAttributes;
VirtualProtect(method, 4, dwOldProtect, dwOldProtect);
finally
obj.Free;
GOldSetColumnAttributes := nil;
end;
end;

class procedure THackGrid.NewSetColumnAttributes;
var
Grid: Pointer;
begin
asm
MOV Grid,EAX
CALL GOldSetColumnAttributes
end;
with TDBGridAccess(Grid) do
if (dgIndicator in Options) and (GIndicatorWidth > DBGrids.IndicatorWidth) then
ColWidths[0] := GIndicatorWidth;
end;

class procedure THackGrid.DrawOrds(Sender: TObject; AState: TGridDrawState);
var
FrameOffs: Integer;
R: TRect;
begin
with TDBGridAccess(Sender) do
begin
R := CellRect(0, DataLink.ActiveRecord+1);
if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
[dgRowLines, dgColLines]) then
FrameOffs := 1 else
FrameOffs := 2;
R.Right := R.Right - 6{FIndicator.Width} - FrameOffs - 2;
DrawText(Canvas.Handle, PChar(IntToStr(DataLink.ActiveRecord+1)), -1, R,
DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
end;
end;

end.

使用：
procedure TForm1.FormCreate(Sender: TObject);
begin
THackGrid.Hook(28);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
THackGrid.Unhook;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
with TDBGrid(Sender) do
begin
Canvas.Font.Color := clBlack;
if DataCol = 0 then // 一行只畫一次
begin
Canvas.Brush.Color := clBtnFace;
THackGrid.DrawOrds(Sender, State);
end;
DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;


2006-1-23 16:24:07 7.顯示行號(2)上面的代碼在數據記錄數<DBGrid顯示行數的時候纔有效，汗！
下面的代碼經測試基本可行，不過在數據集執行Last，當前記錄已經在最後一條並且Eof=True時，再Insert插入，顯示的行號比實際的大1，主要在判斷是Insert插入還是Append添加的操作是通過判斷Eof進行的，這就會導致誤判，其他情況目前還沒有發現顯示不正確的。

unit MyGrid;

interface

uses Windows, Messages, Classes, SysUtils, DB, Grids, DBGrids;

type
TMyDBGrid = class(TDBGrid)
private
FIndicatorWidth: Integer;
FFirstRecNo: Integer;
FOldBeforeInsert: TDataSetNotifyEvent;
procedure DataSetBeforeInsert(DataSet: TDataSet);
function GetDataSource: TDataSource;
procedure SetDataSource(const Value: TDataSource);
procedure SetIndicatorWidth(const Value: Integer);
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
procedure SetColumnAttributes; override;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
public
constructor Create(AOwner: TComponent); override;
published
property IndicatorWidth: Integer read FIndicatorWidth write SetIndicatorWidth default 28;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;

implementation


{ TMyDBGrid }

constructor TMyDBGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIndicatorWidth := 28;
end;

procedure TMyDBGrid.DataSetBeforeInsert(DataSet: TDataSet);
var
iRow: Integer;
begin
iRow := Row;
if dgTitles in Options then Dec(iRow);
FFirstRecNo := DataSet.RecNo - iRow;
if Assigned(FOldBeforeInsert) then FOldBeforeInsert(DataSet);
end;

procedure TMyDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
var
OldActive, iRow, RowNo: Integer;
begin
inherited DrawCell(ACol, ARow, ARect, AState);

if (dgIndicator in Options) then
begin
Dec(ACol);
if dgTitles in Options then Dec(ARow);

if Assigned(DataLink) and DataLink.Active and (ACol < 0) and (ARow >= 0) then
begin
if DataLink.DataSet.State = dsInsert then
begin
if DataLink.DataSet.Eof then // Append
begin
iRow := Row;
if dgTitles in Options then Dec(iRow);
RowNo := DataLink.DataSet.RecordCount - iRow + ARow + 1
end else // Insert
RowNo := FFirstRecNo + ARow;
end
else
begin
OldActive := DataLink.ActiveRecord;
try
DataLink.ActiveRecord := ARow;
RowNo := DataSource.DataSet.RecNo;
finally
DataLink.ActiveRecord := OldActive;
end;
end;

ARect.Right := ARect.Right - 6{FIndicator.Width} - 2{FrameOffs} - 2{Space};
DrawText(Canvas.Handle, PChar(IntToStr(RowNo)), -1, ARect,
DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
end;
end;
end;

function TMyDBGrid.GetDataSource: TDataSource;
begin
Result := inherited DataSource;
end;

procedure TMyDBGrid.SetColumnAttributes;
begin
inherited;
if (dgIndicator in Options) then
ColWidths[0] := FIndicatorWidth;
end;

procedure TMyDBGrid.SetDataSource(const Value: TDataSource);
begin
if Assigned(DataSource) and Assigned(DataSource.DataSet) then
DataSource.DataSet.BeforeInsert := FOldBeforeInsert;

if Assigned(Value) and Assigned(Value.DataSet) then
begin
FOldBeforeInsert := Value.DataSet.BeforeInsert;
Value.DataSet.BeforeInsert := DataSetBeforeInsert;
end else
FOldBeforeInsert := nil;

inherited DataSource := Value;
end;

procedure TMyDBGrid.SetIndicatorWidth(const Value: Integer);
begin
if FIndicatorWidth <> Value then
begin
FIndicatorWidth := Value;
if (dgIndicator in Options) then
ColWidths[0] := FIndicatorWidth;
end;
end;

procedure TMyDBGrid.WMSize(var Message: TWMSize);
var
OldRow: Integer;
begin
OldRow := Row;
inherited;
FFirstRecNo := FFirstRecNo - (Row - OldRow);
end;

end.

測試代碼：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls;

type
TForm1 = class(TForm)
DBNavigator1: TDBNavigator;
ADOConnection1: TADOConnection;
ADOTable1: TADOTable;
DataSource1: TDataSource;
Button1: TButton;
Label1: TLabel;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses MyGrid;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
with TMyDBGrid.Create(Self) do
begin
Parent := Panel1;
Align := alClient;
IndicatorWidth := 40;
Options := Options - [dgTitles];
DataSource := DataSource1;
end;
ADOTable1.Open;
Label1.Caption := IntToStr(ADOTable1.RecordCount);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ADOTable1.Append;
end;

end.