DBGrid的实用技巧

最新推荐文章于 2021-05-26 06:08:46 发布

lcq419

最新推荐文章于 2021-05-26 06:08:46 发布

阅读量940

点赞数

文章标签： integer class dataset constructor interface insert

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.