beyondqd

dbgrid使用大全(delphi)

为 Delphi 数据表格增加色彩

作者： xxxx 发文时间： 2003.07.18 16:29:42

　　在 DELPHI 中经常用到网格控件（ DBGrid ）显示数据，网格控件只提供了每一行的颜色属性，但在实际应用中我们经常希望它按某一行某一项的取值不同显示不同的颜色，甚至在网格中的单位表格项中显示出图像等等，下面我们以一个简单的例子来告诉大家怎么做。

　　比如我们要求如果春季有退书用红色表示，如果秋季有退书用黄色表示

　　利用 DBGrid 自绘功能可以很容易地实现这样的要求。用户可以处理 DBGrid 的 OnDrawColumnCell 事件，在其中实现特殊的效果。要判断记录是否满足要求，可以使用 DBGrid 的 DataLink 属性获得数据，但 DBGrid 的 DataLink 属性属于保护成员，必须在 TCustomDBGrid 的子类中调用。

type

TMyCustomDBGrid = class(TCustomDBGrid);

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

sCjts,sQjTs:String;

begin

with TMyCustomerDBGrid(Sender) do

begin

Cjts:=DataLink.Fields[5].AsString;

sQjts:=DataLink.Fields[9].AsString;

if sCjts<> ‘‘ then 　　　　　　　 // 春季退书数量 >0 的用红色显示

Canvas.Brush.Color := clRed

else

if sQjts<> ‘‘ then 　　　　　　 // 秋季退书数量 >0 的用黄色显示

Canvas.Brush.Color := clYellow

else

Canvas.Brush.Color:=clWhite;

Canvas.Font.Color:=clBlack;

canvas.fillrect(rect);

canvas.textout(rect.left+4,rect.top+4,Column.Field.AsString);

end;

　　由此方法可以延伸出其它控件的多种修饰方法，比如可以按数据项值采用不同的颜色，可以按记录号显示不同的颜色。总之，灵活应用 canvas 、 rect 及 bitmap 等对象，可以将各种网格装饰得绚丽多彩。

如何才能得到 DBGRID 的行号，而不是数据集的行号？

Edit1.Text :=inttostr(TDrawGrid(DBGrid1).Row);

http://www.delphibbs.com/delphibbs/dispq.asp?lid=737517

在 Delphi 语言的数据库编程中， DBGrid 是显示数据的主要手段之一。但是 DBGrid 缺省的外观未免显得单调和缺乏创意。其实，我们完全可以在我们的程序中通过编程来达到美化 DBGrid 外观的目的。通过编程，我们可以改变 DBGrid 的表头、网格、网格线的前景色和背景色，以及相关的字体的大小和风格。

以下的示例程序演示了对 DBGrid 各属性的设置，使 Delphi 显示的表格就像网页中的表格一样漂亮美观。

示例程序的运行：

在 Form1 上放置 DBGrid1 、 Query1 、 DataSource1 三个数据库组件，设置相关的属性，使 DBGrid1 能显示表中的数据。然后，在 DBGrid1 的 onDrawColumnCell 事件中键入以下代码，然后运行程序，就可以看到神奇的结果了。本代码在 Windows98 、 Delphi5.0 环境下调试通过。

procedure TMainForm.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);

var i :integer;

begin

if gdSelected in State then Exit;

// 定义表头的字体和背景颜色：

for i :=0 to (Sender as TDBGrid).Columns.Count-1 do

begin

(Sender as TDBGrid).Columns[i].Title.Font.Name :=' 宋体 '; // 字体

(Sender as TDBGrid).Columns[i].Title.Font.Size :=9; // 字体大小

(Sender as TDBGrid).Columns[i].Title.Font.Color :=$000000ff; // 字体颜色 ( 红色 )

(Sender as TDBGrid).Columns[i].Title.Color :=$0000ff00; // 背景色 ( 绿色 )

end;

// 隔行改变网格背景色：

if Query1.RecNo mod 2 = 0 then

(Sender as TDBGrid).Canvas.Brush.Color := clInfoBk // 定义背景颜色

else

(Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); // 定义背景颜色

// 定义网格线的颜色：

DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);

with (Sender as TDBGrid).Canvas do // 画 cell 的边框

begin

Pen.Color := $00ff0000; // 定义画笔颜色 ( 蓝色 )

MoveTo(Rect.Left, Rect.Bottom); // 画笔定位

LineTo(Rect.Right, Rect.Bottom); // 画蓝色的横线

Pen.Color := $0000ff00; // 定义画笔颜色 ( 绿色 )

MoveTo(Rect.Right, Rect.Top); // 画笔定位

LineTo(Rect.Right, Rect.Bottom); // 画绿色的竖线

end;

2003-11-11 17:07:42 问题 : Delphi5 - 隔行改变 DBGrid 网格颜色在 Form1 上放置 DBGrid1 、 Query1 、 DataSource1 三个数据库组件，设置相关的属性，使 DBGrid1 能显示表中的数据。然后，在 DBGrid1 的 onDrawColumnCell 事件中键入以下代码，然后运行程序

代码 :

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var i:integer;

begin

if gdSelected in State then Exit; // 隔行改变网格背景色：

if adoQuery1.RecNo mod 2 = 0 then

(Sender as TDBGrid).Canvas.Brush.Color := clinfobk // 定义背景颜色

else

(Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); // 定义背景颜色

// 定义网格线的颜色：

DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);

with (Sender as TDBGrid).Canvas do // 画 cell 的边框

begin

Pen.Color := $00ff0000; // 定义画笔颜色 ( 蓝色 )

MoveTo(Rect.Left, Rect.Bottom); // 画笔定位

LineTo(Rect.Right, Rect.Bottom); // 画蓝色的横线

Pen.Color := clbtnface; // 定义画笔颜色 ( 兰色 )

MoveTo(Rect.Right, Rect.Top); // 画笔定位

LineTo(Rect.Right, Rect.Bottom); // 画绿色

end;

用 BDE 中的 table1 未能通过，颜色没有隔行变化。

2003-11-11 17:12:09 在 Delphi 的 DBGrid 中插入其他可视组件 Delphi 提供了功能强大的 DBGrid 组件，以方便进行数据库应用程序设计。但是如果我们仅仅利用 DBGrid 组件，每一个获得焦点（ Grid ）只是一个简单的文本编辑框，不方便用户输入数据。 Delphi 也提供了一些其他数据组件来方便用户输入，比如 DBComboBox ， DBCheckBox 等组件，但这些组件却没有 DBGrid 功能强大。 Delphi 能不能象 Visual Foxpro 那样让 DBGrid 中获得焦点网格可以是其它可视数据组件以方便用户呢？其实我们可以通过在 DBGrid 中插入其他可视组件来实现这一点。

Delphi 对 DBGrid 处理的内部机制，就是在网格上浮动一个组件—— DBEdit 组件。你输入数据的网格其实是浮动 DBEdit 组件，其他未获得焦点地方不过是图像罢了。所以，在 DBGrid 中插入其他可视组件就是在网格上浮动一个可视组件。因此任何组件，包括从简单的 DbCheckBox 到复杂的对话框，都可以在 DBGrid 中插入。下面就是一个如何在 DBGrid 中插入 DBComboBox 组件的步骤，采用同样的办法可以插入其他组件。

1 、在 Delphi 4.0 中新建一个项目。

2 、分别拖动的 Data Access 组件板上 DataSource 、 Table ， Data Controls 组件板上 DBGrid ， DBComboBox 四个组件到 Form1 上。

3 、设置各个组件的属性如下：

rcf1 对象属性设定植

Form1 Caption ' 在 DBGrid 中插入 SpinEdit 组件示例 '

DataSource1 DataSet Table1

Table1 DatabaseName DBDEMOS

TableName 'teacher.DBF'

Active True

DBGrid1 DataSource DataSource1

DBComboBox1 DataField SEX

DataSource DataSource1

Visible False

Strings Items. ' 男 '| ' 女 '

注意：我在这里用了 Teacher.dbf ，那是反映教职工的性别，只能是“男”或者是“女”。

4 、 DrawDataCell 事件是绘制单元格，当获得焦点网格所对应的字段与组合框所对应的字段一致时，移动组合框到获得焦点的网格上，并且使组合框可视，从而达到在 DBGrid 指定列上显示 DBComboBox 的功能。设置 DBGrid1 的 OnDrawDataCell 事件如下：

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

if (gdFocused in State) then

begin

if (Field.FieldName = DBComboBox1.DataField ) then

begin

DBComboBox1.Left := Rect.Left + DBGrid1.Left;

DBComboBox1.Top := Rect.Top + DBGrid1.top;

DBComboBox1.Width := Rect.Right - Rect.Left;

DBComboBox1.Height := Rect.Bottom - Rect.Top;

DBComboBox1.Visible := True;

end;

5 、 DBGrid 指定单元格未获得焦点时不显示 DBComboBox ，设置 DBGrid1 的 OnColExit 事件如下：

procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then

begin

DBComboBox1.Visible := false;

end;

6 、当 DBGrid 指定列获得焦点时 DrawDataCell 事件只是绘制单元格，并显示 DBComboBox ，但是 DBComboBox 并没有获得焦点，数据的输入还是在单元格上进行。在 DBGrid1 的 KeyPress 事件中调用 SendMessage 这个 Windows API 函数将数据输入传输到 DBComboBox 上，从而达到在 DBComboBox 上进行数据输入。因此还要设置 KeyPress 事件如下：

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if (key < > chr(9)) then

begin

if (DBGrid1.SelectedField.FieldName =DBComboBox1.DataField) then

begin

DBComboBox1.SetFocus;

SendMessage(DBComboBox1.Handle ， WM_Char ， word(Key) ， 0);

end;

程序在中文 Windows 98 ， Delphi 4.015 下调试通过。希望本文能使你可以更加方便快捷的开发数据库应用程序。

2003-11-11 17:17:56 锁定 DBGrid 左边的列我在使用 Delphi3 进行数据库编程的时候，希望 DBGRID 构件在显示数据的时候能象 FoxPro 的 BROWSE 命令一样，锁定左边指定的几列不进行滚动，请问应用什么方法来实现？

我们知道 Delphi 的 TStringGrid 有一个属性 FixedCols 来指定不滚动的列。虽然 TDBGrid 不能直接使用这一属性，但通过强制类型转换也可以首先这一功能，因为这两个类都来自 TCustomGrid 类。下面我们以 Delphi 3.0 的 Demos/Db/CtrlGrid 为例来说明具体的用法。在这个例子的 TFmCtrlGrid.FormShow 过程中加入如下一行：

TStringGrid(DbGrid1).FixedCols := 2;

运行该程序，在左右移动各列时， Symbol 列不会移动。除了这种方法，也可以采用下面的方法：首先在 Form 声明部分加上

type TMyGrid = Class(TDBGrid) end;

然后在 TFmCtrlGrid.FormShow 过程中加入：

TMyGrid(DbGrid1).FixedCols := 2;

两者从形式上略有不同，但实质都是一样的。我们这里设置 FixedCols 为 2 ，这是因为在 DBGrid 构件最左侧有个指示列，如果你将 DBGrid 的 Options 属性的 dgIndicator 设为 False ，则应设置 FixedCols 为 1 。

2003-11-11 17:21:36 使 dbgrid 的某几笔资料变色你可在 DBGrid 元件的 DrawDataCell 事件中依资料的条件性来改变格子或文字的颜色 .

如 :

OnDrawDataCell(...)

begin

with TDBGrid(Sender) do

begin

if ( 条件 ) then

Canvas.TextOut(Rect.Left + 4

Rect.Top + 2

' 要显示的文字如表格的资料 ');

end;

而你会看到 DBGrid 的显示资料怎麽有重叠的情况那是因为原本 DBGrid 要显示的资料与 TextOut 所显示的资料重叠

解决方法 :

在 Query 元件所加入的栏位 ( 在元件上按右键会有 Add Fields... 的选单 ) 在不要显示资料的栏位的 OnGetText 事件中有一参数设定为 False;

procedure TForm1.Query1Detail1GetText(Sender: TField; var Text: string;

DisplayText: Boolean);

begin

// 决定在 DBGrid 得知表格资料时要不要显示所得到的资料 False -> 不显示

// 就可避免与 TextOut 的文字重叠了

DisplayText : = False;

end;

如果用 Delphi 3 处理很简单 . 例如 : 对表中某字段当其数值小于 0 时为红字其他为黑字 .

在 DBGrid.OnDrawColumnCell(...) 中 :

begin

if TableField.AsInteger < 0 then

DBGrid.Canvas.Font.Color := clRed

else

DBGrid.Canvas.Font.Color := clBlack;

DBGrid.DefaultDrawColumnCell(...);

end;

这样对 Field 指定的格式仍旧生效不必重写 .

2003-11-11 17:25:29 实战 Delphi 数据网格色彩特效 Delphi 中的数据网格控件 (TDbGrid) 对于显示和编辑数据库中大量的数据起着十分重要的作用；然而，在使用数据网格控件的同时，也往往因为表格中大量的数据不易区分，而令操作者眼花缭乱。如何提高网格控件的易用性，克服它的此项不足呢？本文从改变数据网格的色彩配置角度，提出了一种解决办法。

以下为数据网格控件的 6 种特殊效果的实现方法，至于数据网格控件与数据集如何连接的方法从略。

1. 纵向斑马线效果：实现网格的奇数列和偶数列分别以不同的颜色显示以区别相邻的数据列。

file:// 在 DbGrid 的 DrawColumnCell 事件中编写如下代码：

Case DataCol Mod 2 = 0 of

True: DbGrid1.Canvas.Brush.Color:= clBlue; file:// 偶数列用蓝色

False: DbGrid1.Canvas.Brush.Color:= clAqua; file:// 奇数列用浅绿色

End;

DbGrid1.Canvas.Pen.Mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

2. 纵向斑马线，同时以红色突出显示当前单元格效果：以突出显示当前选中的字段。

file:// 将上述代码修改为：

Case DataCol Mod 2 = 0 of

True: DbGrid1.Canvas.Brush.Color:= clBlue; file:// 偶数列用蓝色

False: DbGrid1.Canvas.Brush.Color:= clAqua; file:// 奇数列用浅绿色

End;

If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

If Not DbGrid1.SelectedRows.CurrentRowSelected then

DbGrid1.Canvas.Brush.Color:=clRed; file:// 当前选中单元格显示红色

DbGrid1.Canvas.Pen.Mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

上述两种方法突出了列的显示效果。

3 ．在数据网格中以红色突出显示当前选中的行。

设置 DbGrid 控件的 Options 属性中的 dgRowSelect 属性为真， Color 属性为 clAqua( 背景色 )

在 DbGrid 的 DrawColumnCell 事件中编写如下代码：

if ((State = [gdSelected]) or (State=[gdSelected gdFocused])) then

DbGrid1.Canvas.Brush.color:=clRed; file:// 当前行以红色显示，其它行使用背景的浅绿色

DbGrid1.Canvas.pen.mode:=pmmask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

4 ．行突显的斑马线效果：既突出当前行，又区分不同的列（字段）。

file:// 其它属性设置同 3 ，将上述代码修改为：

if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

begin

Case DataCol Mod 2 = 0 of

True : DbGrid1.Canvas.Brush.color:=clRed; file:// 当前选中行的偶数列显示红色

False: DbGrid1.Canvas.Brush.color:=clblue; file:// 当前选中行的奇数列显示蓝色

end;

DbGrid1.Canvas.pen.mode:=pmmask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

end;

5 ．横向斑马线，同时以红色突显当前行效果。

file:// 其它属性设置同 3 ，将上述代码修改为：

Case Table1.RecNo mod 2 = 0 of file:// 根据数据集的记录号进行判断

True : DbGrid1.Canvas.Brush.color:=clAqua; file:// 偶数行用浅绿色显示

False: DbGrid1.Canvas.Brush.color:=clblue; file:// 奇数行用蓝色表示

end;

if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then file:// 选中行用红色显示

DbGrid1.Canvas.Brush.color:=clRed;

DbGrid1.Canvas.pen.mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

6 ．双向斑马线效果：即行间用不同色区分，同时，选中行以纵向斑马线效果区分不同的列。

file:// 其它属性设置同 3 ，将上述代码修改为：

Case Table1.RecNo mod 2 = 0 of file:// 根据数据集的记录号进行判断

True : DbGrid1.Canvas.Brush.color:=clAqua; file:// 偶数行用浅绿色显示

False: DbGrid1.Canvas.Brush.color:= clblue; file:// 奇数行用蓝色表示

end;

If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

Case DataCol mod 2 = 0 of

True : DbGrid1.Canvas.Brush.color:=clRed; file:// 当前选中行的偶数列用红色

False: DbGrid1.Canvas.Brush.color:= clGreen; file:// 当前选中行的奇数列用绿色表示

end;

DbGrid1.Canvas.pen.mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

上述 6 种方法分别就数据网格控件的列和行的色彩进行了设置，读者可以根据自己的需要设置特效。该程序在 Delphi5 中测试通过。

2003-11-13 11:11:31 点击 DBGrid 的 Title 对查询结果排序关键词 :DBGrid 排序

欲实现点击 DBGrid 的 Title 对查询结果排序，想作一个通用程序，不是一事一议，例如不能在 SQL 语句中增加 Order by ... ，因为 SQL 可能原来已经包含 Order by ... ，而且点击另一个 Title 时又要另外排序，目的是想作到象资源管理器那样随心所欲。

procedure TFHkdata.SortQuery(Column:TColumn);

var

SqlStr,myFieldName,TempStr: string;

OrderPos: integer;

SavedParams: TParams;

begin

if not (Column.Field.FieldKind in [fkData,fkLookup]) then exit;

if Column.Field.FieldKind =fkData then

myFieldName := UpperCase(Column.Field.FieldName)

else

myFieldName := UpperCase(Column.Field.KeyFields);

while Pos(myFieldName,';')<>0 do

myFieldName := copy(myFieldName,1,Pos(myFieldName,';')-1)+ ',' + copy(myFieldName,Pos(myFieldName,';')+1,100);

with TQuery(TDBGrid(Column.Grid).DataSource.DataSet) do

begin

SqlStr := UpperCase(Sql.Text);

// if pos(myFieldName,SqlStr)=0 then exit;

if ParamCount>0 then

begin

SavedParams := TParams.Create;

SavedParams.Assign(Params);

end;

OrderPos := pos('ORDER',SqlStr);

if (OrderPos=0) or (pos(myFieldName,copy(SqlStr,OrderPos,100))=0) then

TempStr := ' Order By ' + myFieldName + ' Asc'

else if pos('ASC',SqlStr)=0 then

TempStr := ' Order By ' + myFieldName + ' Asc'

else

TempStr := ' Order By ' + myFieldName + ' Desc';

if OrderPos<>0 then SqlStr := Copy(SqlStr,1,OrderPos-1);

SqlStr := SqlStr + TempStr;

Active := False;

Sql.Clear;

Sql.Text := SqlStr;

if ParamCount>0 then

begin

Params.AssignValues(SavedParams);

SavedParams.Free;

end;

Prepare;

Open;

end;

2003-11-13 11:13:57 去掉 DbGrid 的自动添加功能

关键词 :DbGrid

移动到最后一条记录时再按一下“下”就会追加一条记录，如果去掉这项功能

procedure TForm1.DataSource1Change(Sender: TObject; Field: TField);

begin

if TDataSource(Sender).DataSet.Eof then TDataSource(Sender).DataSet.Cancel;

end;

2003-11-16 12:05:46 DBGrid 不支持鼠标的上下移动的解决代码 ( 感谢 wangxian11 提供 ) 自己捕捉 WM_MOUSEWHEEL 消息处理

private

OldGridWnd : TWndMethod;

procedure NewGridWnd (var Message : TMessage);

public

procedure TForm1.NewGridWnd(var Message: TMessage);

var

IsNeg : Boolean;

begin

if Message.Msg = WM_MOUSEWHEEL then

begin

IsNeg := Short(Message.WParamHi) < 0;

if IsNeg then

DBGrid1.DataSource.DataSet.MoveBy(1)

else

DBGrid1.DataSource.DataSet.MoveBy(-1)

end

else

OldGridWnd(Message);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

OldGridWnd := DBGrid1.WindowProc ;

DBGrid1.WindowProc := NewGridWnd;

end;

2003-11-17 14:46:56 dbgrid 中移动焦点到指定的行和列 dbgrid 是从 TCustomGrid 继承下来的，它有 col 与 row 属性，只不过是 protected 的，不能直接访问，要处理一下，可以这样：

TDrawGrid(dbgrid1).row:=row;

TDrawGrid(dbgrid1).col:=col;

dbgrid1.setfocus;

就可以看到效果了。

1 这个方法是绝对有问题的，它会引起 DBGrid 内部的混乱，因为 DBGrid 无法定位当前纪录，如果 DBGrid 只读也就罢了（只读还是会出向一些问题，比如原本只能单选的纪录现在可以出现多选等等，你可以自己去试试），如果 DBGrid 可编辑那问题就可大了，因为当前纪录的关系，你更改的数据字段很可能不是你想象中的

2 我常用的解决办法是将上程序改为（随便设置 col 是安全的，没有一点问题）

Query1.first;

TDrawGrid(dbgrid1).col:=1;

dbgrid1.setfocus;

这就让焦点移到第一行第一列当中

2003-11-17 14:55:26 如何使 DBGRID 网格的颜色随此格中的数据值的变化而变化？在做界面的时候，有时候为了突出显示数据的各个特性（如过大或者过小等），需要通过改变字体或者颜色，本文就是针对这个情况进行的说明。

如何使 DBGRID 网格的颜色随此格中的数据值的变化而变化。如 <60 的网格为红色？

Delphi 中数据控制构件 DBGrid 是用来反映数据表的最重要、也是最常用的构件。在应用程序中，如果以彩色的方式来显示 DBGrid ，将会增加其可视性，尤其在显示一些重要的或者是需要警示的数据时，可以改变这些数据所在的行或列的前景和背景的颜色。

　　 DBGrid 属性 DefaultDrawing 是用来控制 Cell （网格）的绘制。若 DefaultDrawing 的缺省设置为 True ，意思是 Delphi 使用 DBGrid 的缺省绘制方法来制作网格和其中所包含的数据，数据是按与特定列相连接的 Tfield 构件的 DisplayFormat 或 EditFormat 特性来绘制的；若将 DBGrid 的 DefaultDrawing 特性设置成 False ， Delphi 就不绘制网格或其内容，必须自行在 TDBGrid 的 OnDrawDataCell 事件中提供自己的绘制例程（自画功能）。

　　在这里将用到 DBGrid 的一个重要属性：画布 Canvas ，很多构件都有这一属性。 Canvas 代表了当前被显示 DBGrid 的表面，你如果把另行定义的显示内容和风格指定给 DBGrid 对象的 Canvas ， DBGrid 对象会把 Canvas 属性值在屏幕上显示出来。具体应用时，涉及到 Canvas 的 Brush 属性和 FillRect 方法及 TextOut 方法。 Brush 属性规定了 DBGrid.Canvas 显示的图像、颜色、风格以及访问 Windows GDI 对象句柄， FillRect 方法使用当前 Brush 属性填充矩形区域，方法 TextOut 输出 Canvas 的文本内容。

　　以下用一个例子来详细地说明如何显示彩色的 DBGrid 。在例子中首先要有一个 DBGrid 构件，其次有一个用来产生彩色筛选条件的 SpinEdit 构件，另外还有 ColorGrid 构件供自由选择数据单元的前景和背景的颜色。

　　 1. 建立名为 ColorDBGrid 的 Project ，在其窗体 Form1 中依次放入所需构件，并设置属性为相应值，具体如下所列：

　　 Table1 DatabaseName: DBDEMOS

TableName: EMPLOYEE.DB

Active: True;

　　 DataSource1 DataSet: Table1

　　 DBGrid1 DataSource1: DataSource1

DefaultDrawing: False

　　 SpinEdit1 Increment:200

Value: 20000

　　 ColorGrid1 GridOrdering: go16 ＊ 1

　　 2. 为 DBGrid1 构件 OnDrawDataCell 事件编写响应程序：

// 这里编写的程序是 <60 的网格为红色的情况，其他的可以照此类推

　　 procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;Field: TField; State: TGridDrawState);

　　 begin

　　 if Table1.Fieldbyname( ′ Salary ′ ).value<=SpinEdit1.value then

　　 DBGrid1.Canvas.Brush.Color:=ColorGrid1.ForeGroundColor

　　 else

　　 DBGrid1.Canvas.Brush.Color:=ColorGrid1.BackGroundColor;

　　 DBGrid1.Canvas.FillRect(Rect);

　　 DBGrid1.Canvas.TextOut(Rect.left ＋ 2,Rect.top ＋ 2,Field.AsString);

　　 end;

　　这个过程的作用是当 SpinEdit1 给定的条件得以满足时，如′ salary ′变量低于或等于 SpinEdit1.Value 时， DBGrid1 记录以 ColorGrid1 的前景颜色来显示，否则以 ColorGrid1 的背景颜色来显示。然后调用 DBGrid 的 Canvas 的填充过程 FillRect 和文本输出过程重新绘制 DBGrid 的画面。

　　 3. 为 SpinEdit1 构件的 OnChange 事件编写响应代码：

　　 procedure TForm1.SpinEdit1Change(Sender: TObject);

　　 begin

　　 DBGrid1.refresh; // 刷新是必须的，一定要刷新哦

　　 end;

　　当 SpinEdit1 构件的值有所改变时，重新刷新 DBGrid1 。

　　 4. 为 ColorGrid1 的 OnChange 事件编写响应代码：

　　 procedure TForm1.ColorGrid1Change(Sender: TObject);

　　 begin

　　 DBGrid1.refresh; // 刷新是必须的，一定要刷新哦

　 end;

　　当 ColorGrid1 的值有所改变时，即鼠标的右键或左键单击 ColorGrid1 重新刷新 DBGrid1 。

　　 5. 为 Form1 窗体（主窗体）的 OnCreate 事件编写响应代码：

　　 procedure TForm1.FormCreate(Sender: TObject);

　　 begin

　　 ColorGrid1.ForeGroundIndex:=9;

　　 ColorGrid1.BackGroundIndex:=15;

　 end;

　　在主窗创建时，将 ColorGrid1 的初值设定前景为灰色，背景为白色，也即 DBGrid 的字体颜色为灰色，背景颜色为白色。

　　 6. 现在，可以对 ColorDBGrid 程序进行编译和运行了。当用鼠标的左键或右键单击 ColorGrid1 时， DBGrid 的字体和背景颜色将随之变化。

　　在本文中，只是简单展示了以彩色方式显示 DBGrid 的原理，当然，还可以增加程序的复杂性，使其实用化。同样道理，也可以将这个方法扩展到其他拥有 Canvas 属性的构件中，让应用程序的用户界面更加友好。

2003-11-17 14:58:08 判断 Grid 是否有滚动条？这是一个小技巧，如果为了风格的统一的话，还是不要用了。：）

。。。

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then

ShowMessage('Vertical scrollbar is visible!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then

ShowMessage('Horizontal scrollbar is visible!');

。。。

2003-11-17 15:04:27 两个 Grid 的同步滚动在实际制作一个项目当中，有时候需要几个 grid 一起同步滚动以减少用户的操作量。希望下面那段代码对您有一定的参考价值。

{1.}

unit SyncStringGrid;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs, Grids;

type

TSyncKind = (skBoth, skVScroll, skHScroll);

TSyncStringGrid = class(TStringGrid)

private

FInSync: Boolean;

FsyncGrid: TSyncStringGrid;

FSyncKind: TSyncKind;

{ Private declarations }

procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;

procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;

protected

{ Protected declarations }

public

{ Public declarations }

procedure DoSync(Msg, wParam: Integer; lParam: Longint); virtual;

published

{ Published declarations }

property SyncGrid: TSyncStringGrid read FSyncGrid write FSyncGrid;

property SyncKind: TSyncKind read FSyncKind write FSyncKind default skBoth;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Samples', [TSyncStringGrid]);

end;

procedure TSyncStringGrid.WMVScroll(var Msg: TMessage);

begin

if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skVScroll]) then

FSyncGrid.DoSync(WM_VSCROLL, Msg.wParam, Msg.lParam);

inherited;

end;

procedure TSyncStringGrid.WMHScroll(var Msg: TMessage);

begin

if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skHScroll]) then

FSyncGrid.DoSync(WM_HSCROLL, Msg.wParam, Msg.lParam);

inherited;

end;

procedure TSyncStringGrid.DoSync(Msg, wParam: Integer; lParam: Longint);

begin

FInSync := True;

Perform(Msg, wParam, lParam);

FinSync := False;

end;

end.

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

{2.}

private

OldGridProc1, OldGridProc2: TWndMethod;

procedure Grid1WindowProc(var Message: TMessage);

procedure Grid2WindowProc(var Message: TMessage);

public

{...}

procedure TForm1.Grid1WindowProc(var Message: TMessage);

begin

OldGridProc1(Message);

if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or Message.msg = WM_Mousewheel)) then

begin

OldGridProc2(Message);

end;

procedure TForm1.Grid2WindowProc(var Message: TMessage);

begin

OldGridProc2(Message);

if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or (Message.msg = WM_Mousewheel)) then

begin

OldGridProc1(Message);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

OldGridProc1 := StringGrid1.WindowProc;

OldGridProc2 := StringGrid2.WindowProc;

StringGrid1.WindowProc := Grid1WindowProc;

StringGrid2.WindowProc := Grid2WindowProc;

end;

2003-11-19 9:35:04 在 Delphi 中随意控制 DBGrid 每一行的颜色简易方法 Delphi 中使用 DBGrid 控件时，每一列都能按需要随意地改变颜色，但要改变每一行的颜色却很难，那么在不重新制作新控制件的情况下，有没有好的办法让 DBGrid 按照用户自己要求随意改变每一行颜色的？答案是有，下面介绍一种简单的方法。

要改变 DBGrid 每一行的颜色，只要在 ONDrawColumnCell 事件中设定要改变颜色的行的条件，

并指定 DBGrid 的 Canvas.Brush.color 属性并且把 Canvas.pen.mode 属性设成 pmmask ，再调用 DBGrid 的 DefaultDrawColumnCell 方法即可。注意在改变这两个属性前要先保护好原来的

Canvas.Brush.color 属性的值，调节器用完成 DefaultDrawColumnCell 方法后要把原属性值改

回，现以 Delphi/demos/db/clientmd 目录下的演示程序 clintproj.dpr 为例子 , 做简单说明，下面是对程序中的栅格 MemberGrid 的合条件的整行进行变色，变成黑体背景黄色的，其它不合条件的行的颜色为正常字体，白色背景，只在 DrawColumnCelL 事件中设条件其它的不变，如下：

procedure TClientForm.MemberGridDrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

oldcolor:tcolor;

oldpm:tpenmode;

begin

if DM.ProjectTEAM_LEADER.Value = DM.Emp_ProjEMP_NO.Value then { 设定变色的行的条件 }

MemberGrid.Canvas.Font.Style := [fsBold];

MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

{ 上面是演示程序的原内容，以下是增加部分 }

if DM.ProjectTEAM_LEADER.Value =DM.Emp_ProjEMP_NO.Value then { 设定变色的行的条件 }

begin

oldpm:= MemberGrid.Canvas.pen.mode;

oldcolor:= MemberGrid.Canvas.Brush.color;

MemberGrid.Canvas.Brush.color:=clyellow;

MemberGrid.Canvas.pen.mode:=pmmask;

MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

MemberGrid.Canvas.Brush.color:=oldcolor;

MemberGrid.Canvas.pen.mode:=oldpm;

end;

感觉上这个方法和前面的几个颜色控制方法的原理是一样的，都是通过 ONDrawColumnCell 事件来实现变色醒目美化的功能。：）

2003-11-19 9:43:56 如何在 DBGrid 中能支持多项记录的选择这份文档来自国外，粗略看了一下，很有用，推荐给大家学习使用。

【 Question 】： How to do multi-selecting records in TDBGrid?

When you add [dgMultiSelect] to the Options property of a DBGrid, you give yourself the ability to select multiple records within the grid.

The records you select are represented as bookmarks and are stored in the SelectedRows property.

The SelectedRows property is an object of type TBookmarkList. The properties and methods are described below.

// property SelectedRows: TBookmarkList read FBookmarks;

// TBookmarkList = class

// public

{* The Clear method will free all the selected records within the DBGrid *}

// procedure Clear;

{* The Delete method will delete all the selected rows from the dataset *}

// procedure Delete;

{* The Find method determines whether a bookmark is in the selected list. *}

// function Find(const Item: TBookmarkStr;

// var Index: Integer): Boolean;

{* The IndexOf method returns the index of the bookmark within the Items property. *}

// function IndexOf(const Item: TBookmarkStr): Integer;

{* The Refresh method returns a boolean value to notify whether any orphans were dropped (deleted) during the time the record has been selected in the grid. The refresh method can be used to update the selected list to minimize the possibility of accessing a deleted record. *}

// function Refresh: Boolean; True = orphans found

{* The Count property returns the number of currently selected items in the DBGrid *}

// property Count: Integer read GetCount;

{* The CurrentRowSelected property returns a boolean value and determines whether the current row is selected or not. *}

// property CurrentRowSelected: Boolean

// read GetCurrentRowSelected

// write SetCurrentRowSelected;

{* The Items property is a TStringList of TBookmarkStr *}

// property Items[Index: Integer]: TBookmarkStr

// read GetItem; default;

// end;

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;

type

TForm1 = class(TForm)

Table1: TTable;

DBGrid1: TDBGrid;

Count: TButton;

Selected: TButton;

Clear: TButton;

Delete: TButton;

Select: TButton;

GetBookMark: TButton;

Find: TButton;

FreeBookmark: TButton;

DataSource1: TDataSource;

procedure CountClick(Sender: TObject);

procedure SelectedClick(Sender: TObject);

procedure ClearClick(Sender: TObject);

procedure DeleteClick(Sender: TObject);

procedure SelectClick(Sender: TObject);

procedure GetBookMarkClick(Sender: TObject);

procedure FindClick(Sender: TObject);

procedure FreeBookmarkClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Bookmark1: TBookmark;

z: Integer;

implementation

{$R *.DFM}

//Example of the Count property

procedure TForm1.CountClick(Sender: TObject);

begin

if DBgrid1.SelectedRows.Count > 0 then

begin

showmessage(inttostr(DBgrid1.SelectedRows.Count));

end;

//Example of the CurrentRowSelected property

procedure TForm1.SelectedClick(Sender: TObject);

begin

if DBgrid1.SelectedRows.CurrentRowSelected then

showmessage('Selected');

end;

//Example of the Clear Method

procedure TForm1.ClearClick(Sender: TObject);

begin

dbgrid1.SelectedRows.Clear;

end;

//Example of the Delete Method

procedure TForm1.DeleteClick(Sender: TObject);

begin

DBgrid1.SelectedRows.Delete;

end;

This example iterates through the selected rows of the grid and displays the second field of the dataset.

The Method DisableControls is used so that the DBGrid will not update when the dataset is changed. The last position of the dataset is saved as a TBookmark.

The IndexOf method is called to check whether or not the bookmark is still existent.

The decision of using the IndexOf method rather than the Refresh method should be determined by the specific application.

procedure TForm1.SelectClick(Sender: TObject);

var

x: word;

TempBookmark: TBookMark;

begin

DBGrid1.Datasource.Dataset.DisableControls;

with DBgrid1.SelectedRows do

if Count > 0 then

begin

TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

for x:= 0 to Count - 1 do

begin

if IndexOf(Items[x]) > -1 then

begin

DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

end;

DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.EnableControls;

end;

This example allows you to set a bookmark and and then search for the bookmarked record within selected a record(s) within the DBGrid.

//Sets a bookmark

procedure TForm1.GetBookMarkClick(Sender: TObject);

begin

Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;

end;

//Frees the bookmark

procedure TForm1.FreeBookmarkClick(Sender: TObject);

begin

if assigned(Bookmark1) then

begin

DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);

Bookmark1:= nil;

end;

//Uses the Find method to locate the position of the bookmarked record within the selected list in the DBGrid

procedure TForm1.FindClick(Sender: TObject);

begin

if assigned(Bookmark1) then

begin

if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then

showmessage(inttostr(z));

end;

end.

2003-11-19 10:11:21 另外一种可以在在 Delphi 中随意控制 DBGrid 每一行颜色的方法有个问题是在 Delphi 中使用 DBGrid 时，如何让 DBGrid 中每一行颜色按照用户自己的意愿控

制。最初看到这个问题时，我们以为非常非常简单，所以马上动手准备解决它。结果却发现不是

那么回事，传统方法根本不能发挥作用。在电脑面前一直坐到凌晨 4 点，不断地调试，幸运地是凭借平时积累的一点编程经验，终于找到了开门的匙钥。现将它充公，供大家享用。

1 、数据表的建立

在 Delphi 的工具菜单中选择 Database desktop ，在数据库 DBDemos 下建立一个名为

example.db 的数据表。数据表的字段和内容如下：

Name Age Wage

张山 25 500

王武 57 1060

李市 30 520

刘牛 28 390

2 、创建基于 TDBGrid 的 TColoredDBGrid 组件

在 Delphi 组件菜单中，选择 New Component, 在弹出对话框中作以下设置：

Ancestor Type = TDBGrid

Class Name = TColoredDBGrid

然后单击 OK 按钮， Delphi 自动完成组件基本框架的定义。增添 OnDRawColoredDBGrid 事件并

使它出现在 Object Inspector 的 Events 中以便在应用程序中设定改变行颜色的条件。重载

DrawCell 方法，只能自己绘制单元格。不能通过在 OnDrawColumnCell 来设置颜色，因为在

OnDrawColumnCell 改变单元格的颜色会再次触发 OnDrawColumnCell 。

下面就是所创建组件的源程序。

3 、建立应用程序进行验证。

在 Delphi 文件菜单中选择 New 建立新的应用程序工程 Project1 和主窗体 Form1 ，设置 Form1 的

Caption 属性为“控制 DBGrid 行颜色的示例”。在主窗体上添加 Data Source 、 Table 、 Button 和

ColoredDBGrid 组件。设置各组件的属性如下：

Table1.Database=’DBDemos’

Table1.Tablename=’example.db’

Datasource1.Dataset=Table1

ColoredDBGrid1.Datasource=DataSource1

Button1.Caption= ’ 退出’

在 ColoredDBGrid1 的 onDRawColoredDBGrid 事件中输入下列代码，设定由 Wage （工资）来决

定在 ColoredDBGrid1 各行的颜色。

procedure TForm1.ColoredDBGrid1 DRawColoredDBGrid (Sender: TObject; Field: TField; var Color: TColor; var Font: TFont);

Var

p : Integer;

begin

p := Table1.FindField('wage').AsInteger;

// 取得当前记录的 Wage 字段的值。

if (p < 500) then begin

// 程序将根据 wage 值设置各行的颜色。

Color := clGreen;

Font.Style := [fsItalic];

// 不仅可以改变颜色 , 还可以改变字体

end;

if(p >= 500) And (p < 800) then

Color := clRed;

if(p >=800) then begin

Color := clMaroon;

Font.Style := [fsBold];

end;

// 用‘退出’按钮结束程序运行。

procedure TForm1.Button1Click(Sender: TObject);

begin

Close;

end;

2003-11-19 10:16:11 在一个 Dbgrid 中显示多数据库在数据库编程中，不必要也不可能将应用程序操作的所有数据库字段放入一个数据库文件中。正确的数据库结构应是：将数据库字段放入多个数据库文件，相关的数据库都包含一个唯一

的关键字段，在多数据库结构里可以建立联系。

例如：要编制一个人事管理程序，为简化演示程序，只建立两个数据库，每个数据库都只建

立两个字段。

个人简介 jianjie.dbf ，由人事处维护；工资情况 gongzi.dbf ，由财务处维护。

1. 数据库的建立

进入 DataBase Desktop ，建立数据库结构如下：

jianjie.dbf

编号字段名 :bianhao size:4 type:number

姓名字段名 :xingming size:10 type:character

gongzi.dbf

编号字段名 :bianhao size:4 type:number

工资字段名 :gongzi size:4 Dec 2 type:number

注意：两个数据库的 bianhao 字段的 size 、 type 必须一致。实际上，两数据库文件可以分布

在网络的不同计算机上，为便于演示，分别存为″ c: /test/jianjie.dbf ″和 ″ c:/test

/gongzi.dbf ″。

2. 应用程序的编制

启动 Delphi ，新建一个工程，在窗体中加入 Query 控件 Query1 ， databasename 属性设为 c:

/test ；

加入 DataSource 控件 datasource1 ， DataSet 属性设为 Query1 ；加入 DbGrid 控件 dbgrid1 ，

DataSource 属性设为 DataSource1 ，将 Query1.sql 属性设为

SELECT DISTINCT A.bianhao,a.xingming, b.gongzi

FROM ″ jianjie.dbf ″ A, ″ gongzi.DBF ″ b

WHERE A.bianhao=b.bianhao

再将 Query1.enabled 属性设为 True ，不用编译， DbGrid1 就会显示 : bianhao ，

xingming ， gongzi 三个字段。如果 jianjie.dbf 和 gongzi.dbf 中有记录，则记录会显示出来。因

篇幅所限，此文只介绍了 Dbgrid 中显示多个数据库内容的一般方法，读者可在此基础上进行完

善，使该方法更好地适应您的需要。

2003-11-19 10:19:40 在 DBGrid 中如何让回车变为光标右移动

在 Form.OnKeyPress 事件中写如下代码：

if Key = #13 then

if ActiveControl = DBGrid1 then begin

TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1;

Key := #0;

end;

有 2 点需要注意：

1. 当光标达到 DBGird 最右列的时候，再按回车，光标还会停留在原地。

2.Key := #0

2003-11-19 10:25:07 从 DBGrid 中复制记录 procedure TForm1.DBGrid1DblClick(Sender: TObject);

var

x : integer ;

HadToOpen : boolean ;

begin

with Sender as TDBGrid do begin

HadToOpen := not tTarget.Active ;

if HadToOpen then

tTarget.Active := True ;

tTarget.Append ;

for x := 0 to FieldCount - 1 do

case Fields[x].DataType of

ftBoolean : tTarget.FieldByName(Fields[x].FieldName).AsBoolean := Fields[x].AsBoolean

ftString : tTarget.FieldByName(Fields[x].FieldName).AsString := Fields[x].AsString

ftFloat : tTarget.FieldByName(Fields[x].FieldName).AsFloat := Fields[x].AsFloat

ftInteger : tTarget.FieldByName(Fields[x].FieldName).AsInteger := Fields[x].AsInteger

ftDate : tTarget.FieldByName(Fields[x].FieldName).AsDateTime := Fields[x].AsDateTime ;

end ;

tTarget.Post ;

if HadToOpen then

tTarget.Active := False ;

end ;

end;

2003-11-19 10:27:58 使用 DBGrid 的复选项（请参考如何在 DBGrid 中能支持多项记录的选择） procedure TForm1.SelectClick(Sender: TObject);

var

x: word;

TempBookmark: TBookMark;

begin

DBGrid1.Datasource.Dataset.DisableControls;

with DBgrid1.SelectedRows do

if Count <> 0 then

begin

TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

for x:= 0 to Count - 1 do

begin

if IndexOf(Items[x]) > -1 then

begin

DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

end;

DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.EnableControls;

end;

2003-11-19 10:32:27 在 DBGrid 上 Drag & Drop （拖放）我们在做程序中发现，如果能够让用户将一个 Edit 的内容直接拖放到一个 DBGrid 里，会显得很方便，但在程序编制过程中发现，似乎拖放只能拖放到当前的记录上，那假如要拖放到其他记录又怎么办呢，总不能让用户先选择记录，然后再拖放吧。

后来，通过研究发现，当用鼠标点 DBGrid 时， DBGrid 会自动将记录指针移动到所点击的记录上，这就给了我一个思路，让程序模拟在 DBGrid 上的一次点击先让光标移动到那条记录上，然后就可以将拖放的数据写入 DBgrid 里面了。

通过事实证明这个思路是可行的。下面，我就告诉大家我的做法：

1) 首先在 Form 上放一个 DBGrid ，并它能够显示记录， ( 这比较简单，就不用多说了 )

2) 在 Form 上放一个 Edit

3) 修改 Edit 的属性，把 DragMode 改为 dmAutoMatic, 让用户能够拖放

4) 在 Dbgrid 的 DragOver 事件中增加如下代码：让它能够接收 Drag & drop

procedure TForm1.DBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

begin

accept:=true;

end;

5) 在 Dbgrid 的 DragDrop 事件中增加如下代码：让它能够自动跳到光标所指定的记录上

procedure TForm1.DBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Source<>Edit1 then exit;

with Sender as TDbGrid do begin

Perform(wm_LButtonDown,0,MakeLong(x,y));

PerForm(WM_LButtonUp, 0,MakeLong(x,y));

SelectedField.Dataset.edit;

SelectedField.AsString:=Edit1.text;

end;

至此，我们就实现了想要的功能，其中 PerForm 是 TControl 的一个通用方法目的是绕过 Windows 本身的消息循环，而将消息直接发给要发的 Control ，其具体使用方法请参考 Delphi 的帮助。

2003-11-19 10:39:19 如何使 DBGrid 的指针不移动？

【问题】：我用 DBGRID 显示 TABLE 中的内容 , 现在我要从头到尾读一遍 TABLE 里的数据 , 用

Table1.First,Next 来做会使 DBGRID 里面的指针也跟着跑 , 怎么才能使这时候 DBGRID 里面的指针不

动呢 ?

【答案】：使用如下代码即可：

　　 with DataSet do

　　 try

　　 DisableControls;

　　 Do_something;

　　 finally

　　 EnableControls;

　　 end;

2003-11-19 10:42:14 如何动态更新 DBGrid 的颜色？（请同时参考“如何使 DBGRID 网格的颜色随此格中的数据值的变化而变化？”） DBGrid 控件是一个有许多用户接口的显示数据库的控件，以下的程序告诉您如何根据显示的内容改变字体的显示颜色。例如，如果一个城市的人口大于 200 万，我们就让它显示为蓝色。使用的控件事件为 DBGrid.OnDrawColumeCell.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect:TRect;DataCol:

Integer; Column: TColumn; State: TGridDrawState);

begin

if Table1.FieldByName('Population').AsInteger > 20000000 then

DBGrid1.Canvas.Font.Color := clBlue;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

上面的例子是简单的，但是你可以根据自己的需要扩充，例如字体也变化等，甚至你可以调用画圆的函数在数字上画上一个红色的圆圈。

2003-11-19 10:45:14 使用 DBGrid 显示日期在使用 DBGRID 控件时显示 DATATIME 时其年份是为 2 位的，但我们在步入 2000 年后需要显示的日期是 4 位，如： 1998 、 2001 。在数据库中该字段只有在 2000 年后才会显示 4 位，怎么办呢？下面我们就让该字段在 DBGRID 控件中也显示 4 位的日期格式：双击 Table1 控件，就会出现 form1.table 窗体，击右键，选 Add Fields... ，选择日期字段后按 ok ，窗体中就出现了数据库的日期字段名，点日期的那个字段名，属性框里就出现了该字段的信息，里面有一项 DispalyFormat ，在该显示格式里输入 yyyy.mm.dd ，那么 DBGRID 控件就出现完整的日期了。

2003-11-19 10:48:37 在 TDBGrid 控件中实现拖放的另外一个思路（请同时参考在 DBGrid 上 Drag & Drop （拖放））在本 unit 中，自定义 TMyCustomDBGrid=class(TCustomDBGrid), 再如下引用 :

TMyCustomDBGrid(DBGrid1).MouseDown(...)

或

DBGrid1 as TMyCustomDBGrid).MouseDown(...) 即可。

2003-11-19 10:56:11 在 dbgrid 表格中如何设置按回车键相当于单 click ？【例程】：

在窗体 form1 中放入 table1,datasource1,dbgrid1, 设好联连关系，使 dbgrid1 中能正确显示出 table1 的数据。然后：

procedure TForm1.DBGrid1KeyPress(Sender: TObject;

var Key: Char);

begin

with DBGrid1 do

if Key=#13 then

DBGrid1CellClick(Columns[SelectedIndex]);

end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

with DBGrid1 do

showmessage(format('row=%d',[SelectedIndex]));

end;

2003-11-19 11:07:55 Delphi 的 DBGrid 中的下拉列表和查找字段编程方法数据网格是非常流行的数据输入和显示形式，像大家熟悉的 Excel 、 VFP 中的功能强大的 BROWS 等，为广大程序员乐于采用。在用 Delphi 开发数据库应用系统时，利用数据网格 DBGrid 输入数据时，有些字段只允许某几个固定的字符串，像档案案卷的保管期限，只有“永久”、“长期”和“短期”三种，可否从一个下拉列表中进行选择，从而方便输入和避免输入错误呢？还有一些字段，例如职工信息库中的单位编号（在另外的单位库中保存着单位的详细信息），在输入和显示职工数据时，能否不对单位编号进行操作，而代之于更加直观的单位库中的单位名称呢？答案是肯定的， Delphi 的数据网格控件 DBGrid ，支持下拉列表和查找字段的编程，而且，编程的过程都是可视化的，不需要写一行语句。

一、 DBGrid 中的下拉列表

在 DBGrid 网格中实现下拉列表，设置好 DBGrid 中该字段的 PickList 字符串列表、初始的序号值 DropDownRows 即可。以职工信息库中的籍贯字段（字符串类型）为例，具体设计步骤如下：

1 、在窗体上放置 Table1 、 DataSource1 、 DBGrid1 、 DBNavigator1 等控件对象，按下表设置各个对象的属性 :

---------------------------------------

对象属性设定值

---------------------------------------

Table1 DataBase sy1

Table zgk.dbf // 职工信息库

DataSource1 DataSet Table1

DbGrid1 DataSource DataSource1

DBNavigator1 DataSource Datasource1

-------------------------------------------

2 、双击 Table1, 在弹出的 Form1.Table1 窗口中，用右键弹出快捷菜单，单击 Add Fields 菜单项；选择所有的字段后，按 OK 按钮。

3 、修改第 2 步新增字段的 DisplayLabel 属性。以 Table1ZGBH 字段为例，在 Object Inspector 窗口中选择 Table1ZGBH, 修改属性 DisplayLabel= 职工编号，其余字段类似。

4 、双击 DBGrid1, 在弹出的 Editing DBGrid1.Columns 窗口中，单击 Add all Fields 按钮，增加 Table1 的所有字段。

5 、在 Editing DBGrid1.Columns 窗口，选择 jg 这一行，切换到 Object Inspector 窗口，修改它的 PickList.Strings 为“湖北枝江市（换行）北京市（换行）河南平顶山市（换行）浙江德清市”

6 、在 Form1.Oncreate 事件中写入语句：

Table1.Open;

7 、 F9 运行，用鼠标点击某个记录的籍贯字段，右边即出现一个按钮，点击这个按钮，可出现一个下拉列表，包含第 5 步中输入的四行字符串，可用鼠标进行选择。当然也可以自行输入一个并不属下拉列表中的字符串。

二、 DBGrid 中的查找字段

所谓查找字段 (LookUp Field) ，即 DBGrid 中的某个关键字段的数值来源于另外一个数据库的相应字段。运用查找字段技术，不仅可以有效的避免输入错误，而且 DBGrid 的显示方式更为灵活，可以不显示关键字段，而显示源数据库中相对应的另外一个字段的数据。

---- 例如，我们在 DBGrid 中显示和编辑职工信息，包括职工编号、职工姓名、籍贯、所在单位编号，而单位编号来源于另一个数据库表格——单位库，称“单位编号”为关键字段。如果我们直接显示和编辑单位编号的话，将会面对 1 、 2 、 3 等非常不直观的数字，编辑时极易出错。但是如果显示和编辑的是单位库中对应的单位名称话，将非常直观。这就是 DBGrid 的所支持的查找字段带来的好处。

实现 DBGrid 的查找字段同样不需要任何语句，具体设计步骤如下：

1 、在窗体上放置 Table1 、 Table2 、 DataSource1 、 DBGrid1 、 DBNavigator1 等控件对象，按下表设置各个对象的属性 :

---------------------------------------

对象属性设定值

---------------------------------------

Table1 DataBase sy1

Table zgk.dbf // 职工信息库

Table2 DataBase sy1

Table dwk.dbf // 单位信息库

DataSource1 DataSet Table1

DbGrid1 DataSource DataSource1

DBNavigator1 DataSource Datasource1

------------------------------------------

2 、双击 Table1, 在弹出的 Form1.Table1 窗口中，用右键弹出快捷菜单，单击 Add Fields 菜单项；选择所有的字段后，按 OK 按钮。

4 、设置 Table1DWBH.Visible=False 。

5 、在 Form1.Table1 窗口，用右键弹出快捷菜单，单击 New Field 菜单项，新增一个查找字段 DWMC ，在弹出的窗口设置相应的属性 , 按 OK 按钮确认；在 Object Inspector 窗口，设置 Table1DWMC.DisplayLabel= 单位名称。

6 、在 Form1.Oncreate 事件中写入语句：

Table1.Open;

7 、按 F9 运行，当光标移至某个记录的单位名称字段时，用鼠标点击该字段，即出现一个下拉列表，点击右边的下箭头，可在下拉列表中进行选择。在这里可以看出，下拉列表的内容来自于单位信息库，并且不能输入其他内容。

三、 DBGrid 中的下拉列表和查找字段的区别

虽然 DBGrid 中的下拉列表和查找字段，都是以下拉列表的形式出现的，但两者有很大的差别。

1 、用 PickList 属性设置的下拉列表，它的数据是手工输入的，虽然也可以在程序中修改，但动态特性显然不如直接由另外数据库表格提取数据的查找字段。

2 、用 PickList 属性设置的下拉列表，允许输入不属于下拉列表中的数据，但查找字段中只能输入源数据库中关键字段中的数据，这样更能保证数据的完整性。

3 、用 PickList 属性设置的下拉列表设计较为简单。

2003-11-19 11:23:29 Delphi 中定制 DBGrid 控件　　在 Delphi 中 ,DBGrid 控件是一个开发数据库软件不能不使用的控件 , 其功能非常强大 , 可以配合 SQL 语句实现几乎所有数据报表的显示 , 操作也非常简单 , 属性、过程、事件等都非常直观 , 但是使用中 , 有时侯还是需要一些其他功能 , 例如打印、斑马纹显示、将 DBGrid 中的数据转存到 Excel97 中等等。这就需要我们定制 DBGrid, 以更好的适应我们的实际需要定制 DBGrid, 实现了以上列举的功能 , 对于打印功能则是在 DBGrid 的基础上联合 QuickReport 的功能 , 直接进行 DBGrid 的打印及预览 , 用户感觉不到 QuickReport 的存在 , 只需调用方法 WpaperPreview 即可 ; 对于转存数据到 Excel 也是一样 , 不过这里使用的是自动化变量 Excel 而已。由于程序太长 , 不能详细列举 , 这里介绍一个完整的实现斑马纹显示的 DBGrid, 名字是 NewDBGrid 。根据这个小程序 , 读者可以添加其他更好、更多、更实用的功能。

　　 NewDBGrid 的实现原理就是继承 DBGrid 的所有功能 , 同时添加新的属性：

Wzebra,WfirstColor ,WsecondColor 。

当 Wzebra 的值为 True 时 , 显示斑马纹效果 , 其显示的效果是单数行颜色为 WfirstColor, 双数行颜色为 WsecondColor 。具体的见下面程序清单 :

unit NewDBGrid;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, Grids, DBGrids, Excel97;

type

TDrawFieldCellEvent = procedure(Sender: TObject; Field: TField;

var Color: TCOlor; var Font: TFont; Row: Longint) of object;

// 新的数据控件由 TDBGrid 继承而来

TNewDBGrid = class(TDBGrid)

private

// 私有变量

FWZebra: Boolean; // 是否显示斑马颜色

FWFirstColor: TColor; // 单数行颜色

FWSecondColor: TCOlor; // 双数行颜色

FDrawFieldCellEvent: TDrawFieldCellEvent;

procedure AutoInitialize; // 自动初使化过程

procedure AutoDestroy;

function GetWFirstColor: TColor;

//FirstColor 的读写函数及过程

procedure SetWFirstColor(Value: TColor);

function GetWSecondColor: TCOlor;

procedure SetWSecondColor(Value: TColor);

function GetWZebra: Boolean;

procedure SetWZebra(Value: Boolean);

protected

procedure Scroll(Distance: Integer); override;

// 本控件的重点过程

procedure DrawCell(Acol, ARow: Longint; ARect:

TRect; AState: TGridDrawState); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property WZebra: Boolean read GetWZebra write SetWZebra;

property OnDblClick;

property OnDragDrop;

property OnKeyUp;

property OnKeyDown;

property OnKeyPress;

property OnEnter;

property OnExit;

property OnDrawDataCell;

property WFirstColor: TColor

read GetWFirstColor write SetWFirstColor;

property WSecondColor: TColor

read GetWSecondColor write SetWSecondColor;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Data Controls', [TNewDBGrid]);

end;

procedure TNewDBGrid.AutoInitialize;

begin

FWFirstColor := RGB(239, 254, 247);

FWSecondColor := RGB(249, 244, 245);

{ 可以在次添加需要的其它控件及初使化参数 }

end;

procedure TNewDBGrid.AutoDestroy;

begin

{ 在这里释放自己添加参数等占用的系统资源 }

end;

procedure TNewDBGrid.SetWZebra(Value: Boolean);

begin

FWZebra := Value;

Refresh;

end;

function TNewDBGrid.GetWZebra: Boolean;

begin

Result := FWZebra;

end;

function TNewDBGrid.GetWFirstColor: TColor;

begin

Result := FWFirstColor;

end;

procedure TNewDBGrid.SetWFirstColor(Value: TColor);

begin

FWFirstColor := Value;

Refresh;

end;

function TNewDBGrid.GetWSecondColor: TColor;

begin

Result := FWSecondColor;

end;

procedure TNewDBGrid.SetWSecondColor(Value: TColor);

begin

FWSecondColor := Value;

Refresh;

end;

constructor TNewDBGrid.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoInitialize;

end;

destructor TNewDBGrid.Destroy;

begin

AutoDestroy;

inherited Destroy;

end;

// 实现斑马效果

procedure TNewDBGrid.DrawCell(ACol, ARow:

Longint; ARect: TRect; AState: TGridDrawState);

var

OldActive: Integer;

Highlight: Boolean;

Value: string;

DrawColumn: Tcolumn;

cl: TColor;

fn: TFont;

begin

{ 如果处于控件装载状态 , 则直接填充颜色后退出 }

if csLoading in ComponentState then

begin

Canvas.Brush.Color := Color;

Canvas.FillRect(ARect);

Exit;

end;

if (gdFixed in AState) and (ACol - IndicatorOffset < 0) then

begin

inherited DrawCell(ACol, ARow, ARect, AState);

Exit;

end;

{ 对于列标题 , 不用任何修饰 }

if (dgTitles in Options) and (ARow = 0) then

begin

inherited DrawCell(ACol, ARow, ARect, AState);

Exit;

end;

if (dgTitles in Options) then Dec(ARow);

Dec(ACol, IndicatorOffset);

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =

[dgRowLines, dgColLines]) then

begin

{ 缩减 ARect, 以便填写数据 }

InflateRect(ARect, -1, -1);

end

else

with Canvas do

begin

DrawColumn := Columns[ACol];

Font := DrawColumn.Font;

Brush.Color := DrawColumn.Color;

Font.Color := DrawColumn.Font.Color;

if FWZebra then // 如果属性 WZebra 为 True 则显示斑马纹

if Odd(ARow) then

Brush.Color := FWSecondColor

else

Brush.Color := FWFirstColor;

if (DataLink = nil) or not DataLink.Active then

FillRect(ARect)

else

begin

Value := '';

OldActive := DataLink.ActiveRecord;

try

DataLink.ActiveRecord := ARow;

if Assigned(DrawColumn.Field) then

begin

Value := DrawColumn.Field.DisplayText;

if Assigned(FDrawFieldCellEvent) then

begin

cl := Brush.Color;

fn := Font;

FDrawFieldCellEvent(self, DrawColumn.Field, cl, fn, ARow);

Brush.Color := cl;

Font := fn;

end;

Highlight := HighlightCell(ACol, ARow, Value, AState);

if Highlight and (not FWZebra) then

begin

Brush.Color := clHighlight;

Font.Color := clHighlightText;

end;

if DefaultDrawing then

DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);

if Columns.State = csDefault then

DrawDataCell(ARect, DrawColumn.Field, AState);

DrawColumnCell(ARect, ACol, DrawColumn, AState);

finally

DataLink.Activerecord := OldActive;

end;

if DefaultDrawing and (gdSelected in AState) and

((dgAlwaysShowSelection in Options) or Focused)

and not (csDesigning in Componentstate)

and not (dgRowSelect in Options)

and (ValidParentForm(self).ActiveControl = self) then

begin

// 显示当前光标处为蓝底黄字 , 同时加粗显示

Windows.DrawFocusRect(Handle, ARect);

Canvas.Brush.COlor := clBlue;

Canvas.FillRect(ARect);

Canvas.Font.Color := clYellow;

Canvas.Font.Style := [fsBold];

DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);

end;

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =

[dgRowLines, dgColLines]) then

begin

InflateRect(ARect, -2, -2);

DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);

DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);

end;

// 如果移动光标等 , 则需要刷新显示 DBGrid

procedure TNewDBGrid.Scroll(Distance: Integer);

begin

inherited Scroll(Distance);

refresh;

end;

end.

以上程序在 Win98 + Delphi 5 下调试通过。

2003-11-19 11:27:19 在 DBGrid 控件中显示图形　　如果在数据库中设置了一个为 BLOB 类型的字段用于保存图形 , 在使用 DBGrid 控件显示时 , 在表格中显示的是 BLOB, 而无法显示出图形 , 当然 , 有一些第三方控件可以显示出图形 , 但是要去找第三方控件不是一件容易的事 , 而且有些好用的都需要付费。能不能在 DBGrid 中显示图形呢？答案是肯定的。

　　在 DBGrid 的 OnDrawCell 事件中加入如下代码即可在 DBGrid 控件中显示图形。

var

Bmp: TBitmap;

begin

if (Column.Field.DataTyp = ftBLOB) or (Column.Field.DataTyp = ftGraphic) then

begin

Bmp:=TBitmap.Create;

try

Bmp.Assign(Column.Field);

DBGrid1.Canvas.StretchDraw(Rect,Bmp);

Bmp.Free;

Except

Bmp.Free;

end;

　　按照类似的方法 , 就可以在 DBGrid 中显示 Memo 类型的字段内容。

　　另外 , 在往数据库中保存图形时 , 建议使用 EMF 图元文件 , 这样数据库文件的大小不会变的十分惊人 , 我试过了 , 同样是一幅 400*300 的图形 , 如果用位图 , 保存 100 多幅时 , 数据库文件大小会达到近 20MB, 而使用 EMF 矢量图形保存 , 保存 800 多幅时才 260 多 KB, 保存 EMF 矢量图形的方法与保存位图是差不多的 , 在 DBGrid 中显示也差不多 , 只不过 BLOB 型字段内容不能直接 Assign 给 EMF 文件 , 要用 MemoryStream 来中转。

2003-11-19 11:31:15 如何侦测 DBGrid 目前的记录与栏位资讯请问用什麽方式可以抓到游标或滑鼠目前所在 DBGrid 的 Record? 我的意思是 , 让游标所在之 record 可以立即显示在另外的 edit 内

如果您的问题是对应一组 Edit 元件的话 , 建议采用 TDBEdit 或 TDBLabel, 可以不必再费心管记录位置 ;

如果是只有一个 EditBox, 内容要一直反应 DBGrid 的目前记录的目前栏位 , 那可以同时在 DataSource 的 OnDataChange 与 DbGrid 的 OnColEnter 这两个事件中写更新 EditBox 内容的程式 .

例如 DBGrid 的 OnColEnter 事件 :

procedure TForm1.DBGrid1ColEnter(Sender: TObject);

begin

if DBGrid1.SelectedField <> nil then

Edit1.Text := DBGrid1.SelectedField.AsString;

end;

但只靠 OnColEnter 是不够的 , 因为 , 在同一个 Column( 同一个栏位 ) 上下移动反白方格时 , OnColEnter 是不会被触发的 , 所以 , 可以再搭配 OnDataChange 事件 , 在 State 为 dsBrowse 时的 DataChange, 可以视同记录位置的改变 , 以下的程式是呼叫 DBGrid 的 OnColEnter 事件处理程序 :

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);

begin

if DataSource1.State = dsBrowse then

DBGrid1ColEnter(Sender);

end;

2003-11-19 11:39:38 用 DbGrid 制作 edit 录入时的下拉提示框在 Delphi 语言中提拱了不少数据输入的方法 , 如可从数据库中选择或人工输入的控件有 :DBListBox 、 DBComboBox 、 DBLookupListBox 、 DBLookupComboBox 等。但对于这样一个例子 : 数据库名为 dm.db, 其中有两个字段 :

代码 :Code

名称 :Name

要求根据用户输入的代码 , 去获取该代码对应的名称。

一般的用户并不知道代码和名称的对应关系 , 如让用户输入代码 , 选出对应的名称 , 由于上述的控件不能使操作人员看到代码和名称的对应关系 , 如让用户根据代码用下拉框去查找到对应的该条纪录的名称 , 将很难操作。

根据这种情况 , 我编制了下面程序 , 把 DBGrid 做为 Edit 的下拉列表框辅助操作 , 在 DBGrid 中直观地显示出代码和名称的对应关系 , 并且能够根据用户录入代码的变化情况 , 随时更新 DBGrid 中的记录指针 , 使用户可以直观方便地点取所需要的名字 , 而且 DBGrid 是依据用户在 Edit 中输入代码时才显现 , 跳出 Edit 框即消失。这种方法既为用户录入提供了方便 , 又不影响界面的整体美观 , 效果不错。现把该程序提供给大家 , 你们可根据自己的需要 , 对程序进行加工处理 , 应用于程序开发中 , 希望起到抛砖引玉的作用。

【问题】：做这样一个小程序 : 让用户输入代码 , 然后将名称显示在窗体上。

1 、首先我们可以建立一个 Form, 在此 Form 中增加控件 :

Table : Table1, 设置其属性对应代码库 dm.db, 并将 Active 置为 True

DataSource : DataSource1, 设置其属性 DataSet 为 Table1

Edit : CodeEdit,NameEdit 分别对应代码输入框和名称显示框

DBGrid : DBGrid1, 设置其属性 DataSource 为 DataSource1

并把 CodeEdit 的属性 Text 的值置空 ,NameEdit 的属性 Text 的值置空。

2 、对照以下语句 , 修改 CodeEdit 的 OnEnter 、 OnExit 、 OnKeyDown 、 OnKeyUp 事件 :

在 CodeEdit 的 OnEnter 事件如下 :

procedure TForm1.CodeEditEnter(Sender: TObject);

begin

if CodeEdit.text<>'' then

begin

CodeEdit.SelStart:=length(CodeEdit.text);

Table1.locate('code', CodeEdit.text,[lopartialkey]);

End;

end;

CodeEdit 的 OnExit 事件如下 :

procedure TForm1.CodeEditExit(Sender: TObject);

begin

if activecontrol<>dbgrid1 then

begin

dbgrid1.Visible:=false;

Table1.Locate('code',codeedit.text,[lopartialkey]);

if Table1.Eof then

begin

dbgrid1.Visible:=true;

exit;

end;

if not Table1.Eof then

begin

codeedit.Text:=Table1.fieldbyname('code').asstring;

NameEdit.Text := Table1.fieldbyname('name').asstring;

end;

CodeEdit 的 OnKeyDown 事件如下 :

Procedure Tform1.CodeEditKeyDown(Sender: TObject;var Key: Word;Shift: TShiftState);

var

i:integer;

begin

if (Table1.RecordCount>0) then

begin

case key of 48..57:

begin

dbgrid1.Visible:=true;

Table1.Locate('code',CodeEdit.text,[lopartialkey]);

end;

vk_next:

if dbgrid1.Visible then

begin

i:=0;

while (not Table1.Eof) and (i<11) do

begin

Table1.Next;

i:=i+1;

end;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

End;

vk_prior:

if dbgrid1.Visible then

begin

i:=0;

while (not Table1.Bof) and (i<11) do

begin

Table1.prior;

i:=i+1;

end;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

vk_down:

if dbgrid1.Visible then

begin

if not Table1.Eof then

begin

Table1.Next;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

vk_up:

if dbgrid1.Visible then

begin

if not Table1.Bof then

begin

Table1.Prior;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

end

else

dbgrid1.Visible:=false;

CodeEdit.SelStart:=length(CodeEdit.text);

end;

CodeEdit 的 OnKeyUp 事件如下 :

procedure Tform1.CodeEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if (Table1.RecordCount>0) then

begin

if ((key>=48) and (key<=57)) then

Table1.Locate('code',codeedit.text,[lopartialkey]);

if (key=VK_back) and (codeedit.text<>'') then

Table1.Locate('code',codeedit.text,[lopartialkey]);

if (key=VK_BACK) and (codeedit.text='') then

Table1.First;

if (key=vk_down) or (key=vk_up) or (key=vk_prior) or (key=vk_next) then

if dbgrid1.Visible then

codeedit.Text:=Table1.fieldbyname('code').asstring;

end

else

dbgrid1.Visible:=false;

codeedit.SelStart:=length(codeedit.text);

end;

本程序在 Windows98+Delphi4.0 、 5.0 下均调试通过。

2003-11-19 11:49:55 Delphi 的 dbgrid 中根据数据的属性不同显示不同的颜色（请同时参考如何动态更新 DBGrid 的颜色？ / 如何使 DBGRID 网格的颜色随此格中的数据值的变化而变化？）

在应用系统中 , 用户常常要求把数据按不同的颜色显示出来 , 只要你在 Dbgrid 的 DrawColumnCell 事件中加入以下代码就可以了 :

If Query.fieldbyname(' 字段名 ').values 满足条件 then

Begin

Dbgrid.Canvas.Brush.Color := 颜色 ( 如 :clInfoBk) ;

Dbgrid.DefaultDrawColumnCell( Rect, DataCol, Column, [gdFixed,gdFocused,gdSelected] );

End ;

2003-11-19 12:00:18 给 DBGrid 加入排序功能（同时参考“点击 DBGrid 的 Title 对查询结果排序”）

在实际数据库管理系统中，用户对表中数据的操作，最频繁的莫过于浏览查询了，而查询中若能提供为某字段建立的排序功能，则非常有利于用户对“关键数据”的了解。

Windows 的用户都知道，在“我的电脑”或“资源管理器”中打开任一文件夹，若以“详细资料”方式查看，系统会显示出该文件夹下的子文件夹和文件相关信息，如：名称、类型、大小、修改时间，用户只需要单击标题栏中的相应项，则系统自动按该项进行“升序”（或“降序”）的排列显示，这样用户便能轻松查看相应的文件夹或文件对象的内容。

受此启发，考虑能不能在显示数据的 Grid 表格中完成如此功能呢？答案是肯定的。下面以在 Delphi 中的实现方法为例，通过具体内容，介绍该功能的实现。

步骤如下：

一、先建立一数据表

该表以 Delphi 中最常用的 Paradox 为类型，取名为 Student ，反映（在职）学生的基本情况。该表各字段定义如下：

--------------------------------------------

字段名　　　　类型　　　　　　大小

序号　　　　　 Short 型　　　　　 / (Key*)

学号　　　　　 Alpha 型　　　　　 6

出生日期　　　 Date 型　　　　　 /

性别　　　　　 Alpha 型　　　　　 2

婚否　　　　　 Logical 型　　　　 /

英语　　　　　 Number 型　　　　 /

高数　　　　　 Number 型　　　　 /

PASCAL 　　　　 Number 型　　　　 /

备注　　　　　 Memo 型　　　　　 20

-------------------------------------------

保存后，随意往表中输入 3 至 5 条记录内容。

注：①表中必须建立关键索引（为首字段建立）。此处为“序号”字段；

② 该表中使用了 Paradox 常用的几种字段类型，但尚未全部包含。

二、建立项目，实现功能

1 ．新建一项目，并为表单添加相关控件，各控件主要属性如下表：

2 ．建立各 Click 的事件代码

Button1( 打开表 ) 的 Click 事件代码如下：

procedure TForm1.Button1Click(Sender: TObject);

begin

Table1.Open; // 打开 Table1 关联的表 Student

end;

Button2( 关闭表单 ) 的 Click 事件代码如下：

procedure TForm1.Button2Click(Sender: TObject);

begin

Application.Terminate;

end;

DBGrid1 的 TitleClick 事件代码如下：

procedure TForm1.DBGrid1TitleClick(Column: TColumn);

// 注：本过程参数 Column 包含的信息量非常多

begin

MySort(DBGrid1,Column);

end; // 调用字段排序

其中， MySort(DBGrid1,Column) 为自定义的排序过程，具体代码见下述。

3 ．建立通用处理模块

为使该功能具有“通用性”，将其定义为一过程。

首先，预声明过程及建立两个全局私有变量：

...

Type

...

procedure MySort(DBGrid0:TDBGrid; Column: TColumn);// 预声明过程

private

{ Private declarations }

psIndexName:string; // 记录当前索引名称

plAscend:boolean; // 记录当前索引名称的索引状态

public

{ Public declarations }

end;

...

其次，该过程完整代码如下：

procedure TForm1.MySort(DBGrid0:TDBGrid; Column: TColumn);

var

// 本模块使用到的 psIndexName, plAscend 两个变量见上定义

mode:char; // 记录是“升序”还是“降序”

ColName:string; // 记录当前字段名

iCol:Integer; // 记录当前列号

begin

with DBGrid0.DataSource.DataSet as TTable do //Table0

begin

// 检测当前工作表是否已打开

if not Active

then begin

MessageBeep(0);

Application.MessageBox(' 工作表尚未打开！ ',' 停止 ',MB_OK+MB_ICONSTOP);

Abort

end;

// 检测当前字段是否 “能排序”。以下字段类型不能排序

case Column.Field.DataType of

ftBoolean,

ftBytes,

ftBlob, //Binary

ftMemo,

ftGraphic,

ftFmtMemo, //Formatted memo

ftParadoxOle: //OLE

begin

MessageBeep(0);

Application.MessageBox(Pchar(' 项目 "'+Column.FieldName+'"'+' 不能排序！ '),' 停止 ',MB_OK+MB_ICONSTOP);

Abort

end;

end; //case

mode:='0';

iCol:=Column.Field.FieldNo-1;

try

ColName:=Column.fieldname;

if psIndexName=Column.fieldname

then begin // 与原来同列

if plAscend // 升序

then begin

mode:='2';

IndexName:=ColName+'2'; // 应“降序”

end

else begin

mode:='1';

IndexName:=ColName+'1'; // 应“升序”

end;

plAscend:=not plAscend;

end

else begin // 新列

IndexName:=ColName+'2';

plAscend:=false;

psIndexName:=ColName;

end;

except

on EDatabaseError do // 若未有索引，则重新建立

begin

Messagebeep(0);

// 以下新建索引

IndexName:='';

Close;

Exclusive:=true;

if mode='1'

then AddIndex(ColName+'1',ColName,[ixCaseInsensitive],'')//

else // 包括 '0'

AddIndex(ColName+'2',ColName,[ixDescending,ixCaseInsensitive],'');

Exclusive:=false;

Open;

try //try 1

if mode<>'1'

then begin

mode:='2';// 转换

plAscend:=false;

end

else plAscend:=true;

IndexName:=ColName+mode;

psIndexName:=ColName;

except

on EDBEngineError do

IndexName:='';

end //try 2

end

end;

First;

end; //with

DBGrid0.SelectedIndex:=iCol;

end;//End of MySort

本过程已对所有可能的错误进行了相应的检测及处理，代码是比较完整的。因此，把该过程放入你相应的单元中，对每一个 DBGrid ，只要传递不同的 DBGrid 及 Column 参数，就能实现对应数据表的自动排序处理，而事先只为某字段建立一关键索引即可，其它 Secondery Indexes 的建立均在程序中自动完成，但会为每一个建立了索引的字段生成了一些附加文件（如 *.XG?,*YG? 等）。当然若有必要，可以在表单关闭前将所有的附加文件删除。

2003-11-19 12:16:05 将 DBGrid 中的内容输出至 Excel 或 ClipBoard

// 注意 : 下面的方法必须包含 ComObj, Excel97 单元

//-----------------------------------------------------------

// if toExcel = false, export dbgrid contents to the Clipboard

// if toExcel = true, export dbgrid to Microsoft Excel

procedure ExportDBGrid(toExcel: Boolean);

var

bm: TBookmark;

col, row: Integer;

sline: String;

mem: TMemo;

ExcelApp: Variant;

begin

Screen.Cursor := crHourglass;

DBGrid1.DataSource.DataSet.DisableControls;

bm := DBGrid1.DataSource.DataSet.GetBookmark;

DBGrid1.DataSource.DataSet.First;

// create the Excel object

if toExcel then

begin

ExcelApp := CreateOleObject('Excel.Application');

ExcelApp.WorkBooks.Add(xlWBatWorkSheet);

ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data';

end;

// First we send the data to a memo

// works faster than doing it directly to Excel

mem := TMemo.Create(Self);

mem.Visible := false;

mem.Parent := MainForm;

mem.Clear;

sline := '';

// add the info for the column names

for col := 0 to DBGrid1.FieldCount-1 do

sline := sline + DBGrid1.Fields[col].DisplayLabel + #9;

mem.Lines.Add(sline);

// get the data into the memo

for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do

begin

sline := '';

for col := 0 to DBGrid1.FieldCount-1 do

sline := sline + DBGrid1.Fields[col].AsString + #9;

mem.Lines.Add(sline);

DBGrid1.DataSource.DataSet.Next;

end;

// we copy the data to the clipboard

mem.SelectAll;

mem.CopyToClipboard;

// if needed, send it to Excel

// if not, we already have it in the clipboard

if toExcel then

begin

ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;

ExcelApp.Visible := true;

end;

FreeAndNil(mem);

// FreeAndNil(ExcelApp);

DBGrid1.DataSource.DataSet.GotoBookmark(bm);

DBGrid1.DataSource.DataSet.FreeBookmark(bm);

DBGrid1.DataSource.DataSet.EnableControls;

Screen.Cursor := crDefault;

end;

2003-11-19 12:20:56 怎样获得 DBGrid 中的 cell 的坐标 ???// 新建一个工程 , 在窗体上加一个 StringGrid

// 下面是 unit1.pas

unit Unit1;

interface

uses

Windows Messages SysUtils Classes Graphics Controls Forms Dia

logs

Grids;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

procedure FormCreate(Sender: TObject);

procedure StringGrid1DblClick(Sender: TObject);

procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X Y: Integer);

procedure StringGrid1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

const

WeekDayName :Array[1..7] of String=(' 星期一 ' ' 星期二 ' ' 星期三 ' ' 星期四

' ' 星期五 ' ' 星期六 ' ' 星期日 ');

var

X_Pos Y_Pos:integer;// 鼠标在窗体的位置

Col_Pos Row_Pos:integer;// 单元位置

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

begin

Application.HintPause:=100;

Font.Size :=10;

Caption:='STring 岩石程序 ';

StringGrid1.ShowHint :=True;

StringGrid1.ColCount :=8;

StringGrid1.RowCount :=12;

StringGrid1.Cells[0 0]:=' 第 18 周 ';

for i:=1 to StringGrid1.ColCount -1 do

StringGrid1.Cells[i 0]:=WeekDayName[i];

for i:=1 to StringGrid1.RowCount -1 do

StringGrid1.Cells[0 i]:=InttoStr(i+7)+':00';

StringGrid1.Options :=StringGrid1.Options+[goTabs goROwSizing goColSizing]-[goEditing];

end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);

var

SchemeItem:String;

begin

StringGrid1.MouseToCell(X_Pos Y_Pos Col_Pos Row_Pos) ; // 转换到单位位置

if (Col_Pos<0 )or (Row_Pos<0 ) then

Exit;

if (StringGrid1.Cells[Col_Pos Row_Pos]<>'' ) then // 取消计划概要

begin

StringGrid1.Cells[Col_Pos Row_Pos]:='';

Exit;

end;

SchemeItem:=InputBox(' 提示 ' ' 请输入计划概要 :' ' 会议 ');

StringGrid1.Cells[Col_Pos Row_Pos]:=SchemeItem;

End;

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X Y: Integer);

begin

X_Pos:=x;

Y_Pos:=y;

end;

procedure TForm1.StringGrid1Click(Sender: TObject);

begin

StringGrid1.MouseToCell(X_Pos Y_Pos Col_Pos Row_Pos);// 转化到单元位置

StringGrid1.Hint :=StringGrid1.Cells[Col_Pos Row_Pos];// 暂时借用该特性显示工作计划

end;

end.

2003-11-19 12:33:15 多层表头的 DBGrid （推荐大家学习，很有用） TclientDataSet 控件是在 Delphi 中设计多层分布式数据库程序的核心控件，在 Delphi3 中它最早出现，在 Delphi4 和 Delphi5 中得到了进一步加强。 TclientDataSet 控件具有强大的功能，无论是单层、两层 C/S 和多层结构都可以使用 TclientDataSet 控件。从 borland 公司的公布的资料看，它的功能还将得到不断增强，本文主要介绍利用 TclientDataSet 控件的特色功能——抽象字段类型配合 TDBGRID 控件实现复杂题头。

在设计数据库录入界面时，经常需要实现一些复杂题头，这通常需要利用第三方控件或进行特殊处理才能实现。而在 Delphi 中利用 TClientDataSe 的 ADT （抽象字段类型）配合 TDbgrid 控件，可以非常容易地实现这种题头。

下面就以一个员工的工资信息表来说明具体步骤。

假设某单位的工资信息表的结构如图所示。

－－－－－－－－－－－－－－－－－

基本信息

－－－－－－－－－－－－－－－－－

性别 | 年龄 | 籍贯 | 职称

首先生成一个新的 Application, 在窗体上添加一个 TClientDataSet 构件和 TDataSource 构件 , 其 name 属性分别为 ClientDataSet1 和 DataSource1 , 并把 DataSource1 的 DataSource 属性设置为 ClientDataSet1 上；添加一个 TDBGRID 和 TdbNavigator 控件，命名为 DBGRID1 和 DbNavigator1 ，其 Datasource1 属性设置为 ClientDataSet1 。

然后建立 TclientDataSet 的字段定义。这里只介绍如何定义抽象字段：将基本信息和工资作为两个抽象字段，如图 3 所示，将两个字段分别命名为 INFO 和 Salary 。

然后依次建立 INFO 字段和 SALARY 的子字段，单击对象观察器的 ChildDefs ，进入子字段编辑器，依次输入该字段的子字段。然后调用 TclientDataSet 的快捷菜单（鼠标点击 TclientDataSet 控件，然后右击鼠标） CreateDataSet 建立 CDS 数据表，并保存文件。最后建立 TClientDataSet 的永久字段， TclientDataSet 的快捷菜单，选择 ADD All Fields 。

至此有关 ClientDataSet 的设置完毕。

在设置完 ClientDataSet 之后，需要设置 DBGRID 的显示属性。主要就是设置 Colums 的有关属性（略）。编译运行即可出现如图 2 所示的运行界面。然后添加一个 Tdbnavigator 控件，将其 DataSource 属性设置为 Datasource1 。这些与普通的基于 BDE 的数据库应用是一样的，不多叙述。

2003-11-19 13:33:24 在 dbgrid 中实现 copy 、 paste 功能　　工具条上的 Cut 、 Copy 和 Paste 加速按钮 , 对于使用 Windows 下编辑器的人来说 , 恐怕都是非常熟悉而且不可缺少的。 Delphi 中的有些控件 , 如 :TDBEdit 、 TDBImage 、 TDBMemo 、 TEdit 等 , 具有 CutToClipboard 、 CopyToClipboard 和 PasteFromClipboard 方法 , 在这些控件上 , 利用这几个方法 , 只要通过简单的编程 , 就可以实现上述加速按钮。但 TDBGrid 控件却不提供上述方法 , 无法直接实现这几种功能。而在单机的数据库应用程序中 ,TDBGrid 却经常被用来进行数据 ( 包括数字和文字 ) 的输入 , 没有 Copy 和 Paste 功能 , 使用起来深感不便。笔者在编程过程中 , 利用中间控件进行“过渡” , 间接地实现了这几种功能。

　　【主要思路】：既然 TDBGrid 控件无法直接实现 Copy 和 Paste 编辑功能 , 则可以将 TDBGrid 控件中需要进行这几种编辑的字段 (Field) 的内容 , 转移到具备这几种功能的控件 ( 以 TDBEdit 为例 ) 中去 , 编辑完毕后 , 再传回到 TDBGrid 中。

　　【具体方法】：在已设计好的包含有 TDBGrid 控件 ( 设名为 DBGrid1) 的窗体中 , 增加一个 TDBEdit( 设名为 DBEdit1) 控件 , 其 DataSources 属性设为与 DBGrid1 的 DataSources 属性相同 , 对 DBGrid1 控件的 OnColEnter 事件编程 , 使 DBEdit1 的 DataField 属性值等于 DBGrid1 控件的被选择字段的字段名。再在窗体中增加两个快速按钮 :Copy 和 Paste, 图形可选 Delphi 子目录下 Images ι Buttons 子目录里的 Copy.bmp 和 Paste.bmp 。

对 Copy 快速按钮的 OnClick 事件编程 :

　　 DBEdit1.CopyToClipboard;

　　对 Paste 快速按钮的 OnClick 事件编程 :

　　 DBEdit1.PasteFromClipboard;

　　 DBGrid1.SelectedField.AsString:=DBEdit1.Text;

　　此时 , 如果 DBGrid1 中的某一单元 Cell 数字需要粘贴另一单元 Cell2 的部分或全部内容 , 用鼠标单击选择 Cell2, 此时 DBEdit1 所显示的内容与 Cell2 的内容相同。在 DBEdit1 中用鼠标拖曳选择部分或全部内容 , 单击 Copy 快速按钮 ; 再用鼠标单击选择 Cell, 此时 DBEdit1 所显示的内容与 Cell 相同 , 在 DBEdit 中欲粘贴刚才所选内容的位置插入光标 , 单击 Paste 快速按钮 , 则刚才所选内容插入到光标位置 ,Cell 的内容也随之改变成插入后的内容 , 由此完成了一次 Copy — Paste 操作。

　　用这种方法实现 Copy — Paste 操作 , 比正常的操作多了一次鼠标的键击、两次鼠标的移动。在重复输入的内容不多 , 且操作者键盘输入很快很熟练的情况下 , 这种实现 Copy — Paste 的方法 , 意义似乎不大。但如果应用程序的使用者是那些并没有掌握某种快速文字输入技巧、很有可能还在使用拼音输入法的人 , 如果使用者对正常的 Copy — Paste 方法本来就不熟练 ( 则感觉不到这种方法的不合常规 ), 且又非常地善于在一长串的同音字里翻来翻去地寻找的话 , 这还是一种不错的方法。如果哪位读者有能在 TDBGrid 中实现常规 Copy — Paste 操作的方法 , 请不吝赐教。

　　以下是有关的程序代码 :

　　 procedure TUnitDetail.DBGrid1ColEnter(Sender:TObject);

　　 begin

　　 case DBGrid1.SelectedIndex of

　　 0:DBEdit1.DataField:='Unit  Num';

　 1:DBEdit1.DataField:='UnitName';

　　 2:DBEdit1.DataField:='Header';

　　 3:DBEdit1.DataField:='Address';

　　 4:DBEdit1.DataField:='Tel';

　　 end;

　　 procedure TUnitDetail.SBCopyClick(Sender:TObject);

　　 begin

　　 DBEdit1.CopyToClipboard;

　　 end;

　　 procedureTUnitDetail.SBPasteClick(Sender:TObject);

　　 begin

　　 DBEdit1.PasteFromClipboard;

　　 DBGrid1.SelectedField.AsString:=DBEdit1.text;

　　 end;

2003-11-19 13:34:33 禁止在 DBGrid 中按 delete 删除记录 procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if (ssctrl in shift) and (key=vk_delete) then key:=0;

end;

2003-11-19 13:39:54 给 DBGrid 添加搜索功能下面给出一个完整的例子，要注意的是：一开始需要将查询的字段全部加入 TDBGrid 中，否则会有访问冲突的。

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls, ExtCtrls, DBCtrls;

type

TTFm_Main = class(TForm)

qry_Data: TQuery;

Ds_Data: TDataSource;

Ed_Search: TEdit; // 附加一个 TEdit 框 .

dbg_Data: TDBGrid;

Database1: TDatabase; // 数据库构件，试验时可任意设定。

DBNavigator1: TDBNavigator;

procedure dbg_DataTitleClick(Column: TColumn);

procedure FormCreate(Sender: TObject);

procedure Ed_SearchChange(Sender: TObject);

private

{ Private declarations }

FQueryStatement: string; // SQL 查询语句。

FALphaNumericKeyPress: TKeyPressEvent;

public

{ Public declarations }

property QueryStatement: string read FQueryStatement;

procedure FloatOnKeyPress(Sender: TObject; var Key: Char);

end;

var

TFm_Main: TTFm_Main;

implementation

{$R *.DFM}

procedure TTFm_Main.dbg_DataTitleClick(Column: TColumn);

var

vi_Counter: Integer;

vs_Field: string;

begin

with dbg_Data do

begin

//First, deselect all the Grid Columns

for vi_Counter := 0 to Columns.Count - 1 do

Columns[vi_Counter].Color := clWindow;

//Next "Select" the column the user has Clicked on

Column.Color := clTeal;

//Get the FieldName of the Selected Column

vs_Field := Column.FieldName;

//Order the Grid Data by the Selected column

with qry_Data do

begin

DisableControls;

Close;

SQL.Clear;

SQL.Text := QueryStatement + ' ORDER BY ' + vs_Field;

Open;

EnableControls;

end;

//Get the DataType of the selected Field and change the Edit event

//OnKeyPress to the proper method Pointer

case Column.Field.DataType of

ftFloat: Ed_Search.OnKeyPress := FloatOnKeyPress;

else

Ed_Search.OnKeyPress := FALphaNumericKeyPress;

end;

procedure TTFm_Main.FloatOnKeyPress(Sender: TObject; var Key: Char);

begin

if not (Key in ['0'..'9', #13, #8, #10, #46]) then

Key := #0;

end;

procedure TTFm_Main.FormCreate(Sender: TObject);

begin

//Keep a pointer for the default event Handler

FALphaNumericKeyPress := Ed_Search.OnKeyPress;

//Set the original Query SQL Statement

FQueryStatement := 'SELECT * FROM your_table_name';

//Select the first Grid Column

dbg_DataTitleClick(dbg_Data.Columns[0]);

end;

procedure TTFm_Main.Ed_SearchChange(Sender: TObject);

var

vi_counter: Integer;

vs_Field: string;

begin

try

with dbg_Data do

begin

//First determine wich is the Selected Column

for vi_Counter := 0 to Columns.Count - 1 do

if Columns[vi_Counter].Color = clTeal then

begin

vs_Field := Columns[vi_Counter].FieldName;

Break;

end;

//Locate the Value in the Query

with qry_Data do

case Columns[vi_Counter].Field.DataType of

ftFloat: Locate(vs_Field, StrToFloat(Ed_Search.Text),

[loCaseInsensitive, loPartialKey]);

else

Locate(vs_Field, Ed_Search.Text, [loCaseInsensitive, loPartialKey]);

end;

except

end;

end.

2003-11-19 13:53:23 数据网格自动适应宽度 /////// 源代码开始

uses

Math;

function DBGridRecordSize(mColumn: TColumn): Boolean;

{ 返回记录数据网格列显示最大宽度是否成功 }

begin

Result := False;

if not Assigned(mColumn.Field) then Exit;

mColumn.Field.Tag := Max(mColumn.Field.Tag,

TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));

Result := True;

end; { DBGridRecordSize }

function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;

{ 返回数据网格自动适应宽度是否成功 }

var

I: Integer;

begin

Result := False;

if not Assigned(mDBGrid) then Exit;

if not Assigned(mDBGrid.DataSource) then Exit;

if not Assigned(mDBGrid.DataSource.DataSet) then Exit;

if not mDBGrid.DataSource.DataSet.Active then Exit;

for I := 0 to mDBGrid.Columns.Count - 1 do begin

if not mDBGrid.Columns[I].Visible then Continue;

if Assigned(mDBGrid.Columns[I].Field) then

mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag,

mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset

else mDBGrid.Columns[I].Width :=

mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;

mDBGrid.Refresh;

end;

Result := True;

end; { DBGridAutoSize }

/////// 源代码结束

/////// 使用示例开始

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

DBGridRecordSize(Column);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

DBGridAutoSize(DBGrid1);

end;

/////// 使用示例结束

2003-11-19 13:55:47 移除 DBGrid 的垂直滚动条（参考“判断 Grid 是否有滚动条？”） type

TNoVertScrollDBGrid = class(TDBGrid)

protected

procedure Paint; override;

end;

procedure Register;

implementation

procedure TNoVertScrollDBGrid.Paint;

begin

SetScrollRange(Self.Handle, SB_VERT, 0, 0, False);

inherited Paint;

end;

procedure Register;

begin

RegisterComponents('Data Controls', [TNoVertScrollDBGrid]);

end;

end.

2003-11-19 14:00:48 DBGrid 拖放的例子（请同时参考“在 TDBGrid 控件中实现拖放的另外一个思路 / 在 DBGrid 上 Drag & Drop （拖放）”） unit GridU1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls;

type

TForm1 = class(TForm)

MyDBGrid1: TDBGrid;

Table1: TTable;

DataSource1: TDataSource;

Table2: TTable;

DataSource2: TDataSource;

MyDBGrid2: TDBGrid;

procedure MyDBGrid1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure MyDBGrid1DragOver(Sender, Source: TObject;

X, Y: Integer; State: TDragState; var Accept: Boolean);

procedure MyDBGrid1DragDrop(Sender, Source: TObject;

X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

var

SGC : TGridCoord;

procedure TForm1.MyDBGrid1MouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

DG : TDBGrid;

begin

DG := Sender as TDBGrid;

SGC := DG.MouseCoord(X,Y);

if (SGC.X > 0) and (SGC.Y > 0) then

(Sender as TDBGrid).BeginDrag(False);

end;

procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject;

X, Y: Integer; State: TDragState; var Accept: Boolean);

var

GC : TGridCoord;

begin

GC := (Sender as TDBGrid).MouseCoord(X,Y);

Accept := Source is TDBGrid and (GC.X > 0) and (GC.Y > 0);

end;

procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject;

X, Y: Integer);

var

DG : TDBGrid;

GC : TGridCoord;

CurRow : Integer;

begin

DG := Sender as TDBGrid;

GC := DG.MouseCoord(X,Y);

with DG.DataSource.DataSet do begin

with (Source as TDBGrid).DataSource.DataSet do

Caption := 'You dragged "'+Fields[SGC.X-1].AsString+'"';

DisableControls;

CurRow := DG.Row;

MoveBy(GC.Y-CurRow);

Caption := Caption+' to "'+Fields[GC.X-1].AsString+'"';

MoveBy(CurRow-GC.Y);

EnableControls;

end;

end.

2003-11-24 11:03:41 解决 dbgrid 上下移动的另外一种办法不用重新寫控件 , 也不用改控件 ! 直接將光色代碼部分加到你的窗體單無中就行 .

type

【 TDBGrid = class(DBGrids.TDBGrid)

private

FOldGridWnd : TWndMethod;

procedure NewGridWnd (var Message : TMessage);

public

constructor Create(AOwner: TComponent); override;

end; 】

TXXXForm = class(TForm)

......

end;

{ TDBGrid }

【 constructor TDBGrid.Create(AOwner: TComponent);

begin

inherited;

Self.FOldGridWnd := Self.WindowProc;

Self.WindowProc := NewGridWnd;

end;

procedure TDBGrid.NewGridWnd(var Message: TMessage);

var

IsNeg : Boolean;

begin

if Message.Msg = WM_MOUSEWHEEL then

begin

IsNeg := Short(Message.WParamHi) < 0;

if IsNeg then

self.DataSource.DataSet.MoveBy(1)

else

self.DataSource.DataSet.MoveBy(-1)

end

else Self.FOldGridWnd(Message);

end;

】

TDBGrid = class(DBGrids.TDBGrid)

....

end;

一定要放在最前面 , 也可以將【】紅色部分代碼寫一共用單無中 ,

然後 uses publicunit;

再加上這一句 :

TDBGrid = Class(publicunit.TDBGrid);

TXXFrom =Class(TForm)

2003-11-25 17:29:59 修改过的 Grids ，可以支持鼠标滚轮翻页的功能。拷贝到 /delphi/source/vcl 目录下就能使用。不过我用的是 D7 ，低版本的朋友还是先看看再使用，以防不测。

修改过的 Grids ，可以支持鼠标滚轮翻页的功能。

2003-12-1 10:29:21 可以支持鼠标滚轮翻页的功能的 Grids 详细说明见内。

可以支持鼠标滚轮翻页的功能的 Grids

2003-12-9 10:34:26 关于 DBGrid 中下拉列表的两种设计比较一、 DBGrid 中的下拉列表

1 、在窗体上放置 Table1 、 DataSource1 、 DBGrid1 、 DBNavigator1 等控件对象，按下表设置各个对象的属性 :

---------------------------------------

对象属性设定值

---------------------------------------

Table1 DataBase sy1

TableName zgk.dbf // 职工信息库

DataSource1 DataSet Table1

DbGrid1 DataSource DataSource1

DBNavigator1 DataSource Datasource1

-------------------------------------------

2 、双击 Table1 ，在弹出的 Form1.Table1 窗口中，用右键弹出快捷菜单，单击 Add Fields 菜单项；选择所有的字段后，按 OK 按钮。

3 、修改第 2 步新增字段的 DisplayLabel 属性。以 Table1ZGBH 字段为例，在 Object Inspector 窗口中选择 Table1ZGBH ，修改属性 DisplayLabel= 职工编号，其余字段类似。

4 、双击 DBGrid1 ，在弹出的 Editing DBGrid1.Columns 窗口中，单击 Add all Fields 按钮，增加 Table1 的所有字段。

5 、在 Editing DBGrid1.Columns 窗口，选择 jg 这一行，切换到 Object Inspector 窗口，修改它的 PickList.Strings 为

“湖北枝江市

北京市

河南平顶山市

浙江德清市”

6 、在 Form1.Oncreate 事件中写入语句：

Table1.Open;

二、 DBGrid 中的查找字段

例如，我们在 DBGrid 中显示和编辑职工信息，包括职工编号、职工姓名、籍贯、所在单位编号，而单位编号来源于另一个数据库表格——单位库，称“单位编号”为关键字段。如果我们直接显示和编辑单位编号的话，将会面对 1 、 2 、 3 等非常不直观的数字，编辑时极易出错。但是如果显示和编辑的是单位库中对应的单位名称话，将非常直观。这就是 DBGrid 的所支持的查找字段带来的好处。

实现 DBGrid 的查找字段同样不需要任何语句，具体设计步骤如下：

1 、在窗体上放置 Table1 、 Table2 、 DataSource1 、 DBGrid1 、 DBNavigator1 等控件对象，按下表设置各个对象的属性 :

---------------------------------------

对象属性设定值

---------------------------------------

Table1 DataBase sy1

TableName zgk.dbf // 职工信息库

Table2 DataBase sy1

TablenAME dwk.dbf // 单位信息库

DataSource1 DataSet Table1

DbGrid1 DataSource DataSource1

DBNavigator1 DataSource Datasource1

------------------------------------------

2 、双击 Table1 ，在弹出的 Form1.Table1 窗口中，用右键弹出快捷菜单，单击 Add Fields 菜单项；选择所有的字段后，按 OK 按钮。

4 、设置 Table1DWBH.Visible=False 。

5 、在 Form1.Table1 窗口，用右键弹出快捷菜单，单击 New Field 菜单项，新增一个查找字段 DWMC ，在弹出的窗口设置相应的属性，按 OK 按钮确认；在 Object Inspector 窗口，设置 Table1DWMC.DisplayLabel= 单位名称。

6 、在 Form1.Oncreate 事件中写入语句：

Table1.Open;

三、 DBGrid 中的下拉列表和查找字段的区别

虽然 DBGrid 中的下拉列表和查找字段，都是以下拉列表的形式出现的，但两者有很大的差别。

3 、用 PickList 属性设置的下拉列表设计较为简单。

2003-12-10 14:44:11 用 dbgrid 或 dbgrideh 如何让所显示数据自动滚动？ procedure TForm1.Timer1Timer(Sender: TObject);

var

m:tmessage;

begin

m.Msg:=WM_VSCROLL;

m.WParamLo:=SB_LINEDOWN;

m.WParamHi:=1 ;

m.LParam:=0;

postmessage(self.DBGrid1.Handle,m.Msg,m.WParam,m.LParam);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

self.Timer1.Enabled:=true;

end;

如果需要让他自动不断地从头到尾滚动，添加如下代码

if table1.Eof then table1.First;

2003-12-10 14:58:31 DBGrid 对非布尔字段的栏中如何出现 CheckBox 选择输入可将 dbgrid 关联的 dataset 中需显示特殊内容字段设为显式字段，并在 OnGetText 事件中写如下代码：

以 table 举例：

procedure TForm1.Table1Myfield1GetText(Sender: TField;

var Text: String; DisplayText: Boolean);

var Pd:string;

begin

inherited;

pd:=table1.fieldbyname('myfield1').asstring;

if pd='1' then

Text:=' □ '

else

if pd='2' then

text:=' ▲ '

else

Text:=' √ ';

end;

2003-12-15 9:22:15 DbGrid 控件隐藏或显示标题栏 DbGrid 控件隐藏或显示标题栏

1 、新建一个带两个参数的过程 ( 第 1 个参数是菜单对象，第 2 个是 DbGrid 控件 ):

Procedure ViewTitle(Sender:TObject;DbgColumns:TDBGrid);

// 隐藏或显示 DbGrid 标题栏

2 、然后按 Ctrl+Shift+C 组合键 , 定义的过程会在实现部分出现。

Procedure FrmStock.ViewTitle(Sender:TObject;DbgColumns:TDBGrid);

begin

With (Sender as TMenuItem) do

begin

Checked:=not Checked;

DbgColumns.Columns[Tag].Visible:=Checked;

end;

3 、把菜单子项的 Tag 设置成跟 DbGrid 的 Columns 值相对应 , 比如 :

DbGrid 有一个标题栏是‘日期‘在第 0 列 , 然后把要触法该列的菜单的 Tag 设置成 0 。

4 、把菜单的 OnClick 事件选择 ViewTitle 该过程。

2003-12-16 11:48:15 有关双击 dbgrid 排序的问题（想让用户双击 dbgird 控件的某一个字段时就升序 , 再双击就降序 ....? ）【 DFW ： DouZheng 】 procedure TForm1.DBGrid1TitleClick(Column: TColumn);

var

temp, title: string;

begin

temp := Column.FieldName;

qusp.Close;

if Column.Index <> lastcolumn then

begin

if (Pos(' ↑ ', DBGrid1.Columns[LastColumn].Title.Caption) > 0) or (Pos(' ↓ ', DBGrid1.Columns[LastColumn].Title.Caption) > 0) then

DBGrid1.Columns[LastColumn].Title.Caption := Copy(DBGrid1.Columns[LastColumn].Title.Caption, 3, Length(DBGrid1.Columns[LastColumn].Title.Caption) - 2);

qusp.Sql[icount] := 'order by ' + temp + ' asc';

DBGrid1.Columns[Column.Index].Title.Caption := ' ↑ ' + DBGrid1.Columns[Column.Index].Title.Caption;

lastcolumn := column.Index;

end

else

begin

LastColumn := Column.Index;

title := DBGrid1.Columns[LastColumn].Title.Caption;

if Pos(' ↑ ', title) > 0 then

begin

qusp.Sql[icount] := 'order by ' + temp + ' desc';

Delete(title, 1, 2);

DBGrid1.Columns[LastColumn].Title.Caption := ' ↓ ' + title;

end

else if Pos(' ↓ ', title) > 0 then

begin

qusp.Sql[icount] := 'order by ' + temp + ' asc';

Delete(title, 1, 2);

DBGrid1.Columns[LastColumn].Title.Caption := ' ↑ ' + title;

end

else

begin

qusp.Sql[icount] := 'order by ' + temp + ' asc';

DBGrid1.Columns[LastColumn].Title.Caption := ' ↑ ' + title;

end;

qusp.Open;

end;

2003-12-16 17:02:46 在 DBGrid 中，怎样才能让我能点击一个单元格选择整行，又可以编辑单元格的内容呢？【 hongxing_dl 提供代码】在设计过程中，有时候数据较大量， field 较多的时候，只是点击单元格可能会对某个 field 的数据误操作（如数据错行），为此才会想到这个问题，解决办法如下：

点击单元格就改当前行颜色。这个办法也算是没办法的办法吧！

type

TMyDBGrid=class(TDBGrid);

//////////////////////////////////

//DBGrid1.Options->dgEditing=True

//DBGrid1.Options->dgRowSelect=False

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

with TMyDBGrid(Sender) do

begin

if DataLink.ActiveRecord=Row-1 then

begin

Canvas.Font.Color:=clWhite;

Canvas.Brush.Color:=$00800040;

end

else

begin

Canvas.Brush.Color:=Color;

Canvas.Font.Color:=Font.Color;

end;

DefaultDrawColumnCell(Rect,DataCol,Column,State);

end;

测试通过（ d7 ）！

2003-12-17 13:52:49 怎样在 DbGrid 的左边，实现像 EXCEL 那样的自动编号？这些编号与表无关 . 呵呵，很厉害的 Grid 控件强人 hongxing_dl ，以下是他的代码（可以解决问题）

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Grids, DBGrids, StdCtrls, Buttons, Db, DBTables, ExtCtrls, jpeg;

const ROWCNT=20;

type

tmygrid=class(tdbgrid)

protected

procedure Paint;override;

procedure DrawCell(ACol:Integer;ARow:Integer;ARect:TRect;AState:TGridDrawState);override;

public

constructor create(AOwner:TComponent);override;

destructor destroy;override;

end;

TForm1 = class(TForm)

BitBtn1: TBitBtn;

DataSource1: TDataSource;

Table1: TTable;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

mygrid:tmygrid;

implementation

{$R *.DFM}

{tmygrid}

constructor tmygrid.create(AOwner:TComponent);

begin

inherited create(Owner);

RowCount:=ROWCNT;

end;

destructor tmygrid.destroy;

begin

inherited;

end;

procedure tmygrid.Paint;

begin

RowCount:=ROWCNT;

if dgIndicator in options then

ColWidths[0]:=30;

inherited;

end;

procedure tmygrid.DrawCell(ACol:Integer;ARow:Integer;ARect:TRect;AState:TGridDrawState);

begin

inherited;

if (ARow>=1) and (ACol=0) then

Canvas.TextRect(ARect,ARect.Left,ARect.Top,IntToSTr(ARow));

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

mygrid:=tmygrid.create(Self);

mygrid.parent:=self;

mygrid.left:=0;

mygrid.top:=0;

mygrid.Height:=300;

mygrid.DataSource:=DataSource1;

end;

end.

2003-12-22 9:22:15 如何将几个 DBGRID 里的内容导入同一个 EXCEL 表中？前言：

　　在软件实际制作中，为节省开发成本和开发周期，一些软件人员通常会吧 DBGrid 中的数据直接导出到 Excel 表中，而先前能看到的函数仅仅只能在 WorkBook 的一个 Sheet 中导入数据，不支持多 Sheet ！。

单元应用：

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,

Excel2000, OleServer;

测试环境：

　　 OS ： Win2k Pro ； Excel2k ； Delphi6.0

源程序：　　

{

功能描述：把 DBGrid 输出到 Excel 表格（支持多 Sheet ）

设计： CoolSlob

日期： 2002-10-23

支持： [email protected]

调用格式： CopyDbDataToExcel([DBGrid1, DBGrid2]);

}

procedure CopyDbDataToExcel(Args: array of const);

var

iCount, jCount: Integer;

XLApp: Variant;

Sheet: Variant;

I: Integer;

begin

Screen.Cursor := crHourGlass;

if not VarIsEmpty(XLApp) then

begin

XLApp.DisplayAlerts := False;

XLApp.Quit;

VarClear(XLApp);

end;

try

XLApp := CreateOleObject(‘Excel.Application‘);

except

Screen.Cursor := crDefault;

Exit;

end;

XLApp.WorkBooks.Add;

XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do

begin

XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;

Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];

if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then

begin

Screen.Cursor := crDefault;

Exit;

end;

TDBGrid(Args[I].VObject).DataSource.DataSet.first;

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;

while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do

begin

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);

TDBGrid(Args[I].VObject).DataSource.DataSet.Next;

end;

XlApp.Visible := True;

Screen.Cursor := crDefault;

end;

2003-12-22 9:25:32 DbGrid 控件的标题栏弹出菜单 DbGrid 控件的标题栏弹出菜单

procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

CurPost:TPoint;

begin

GetCursorPos(CurPost);// 获得鼠标当前坐标

if (y<=17) and (x<=vCurRect.Right) then

begin

if button=mbright then

begin

PmTitle.Popup(CurPost.x,CurPost.y);

end;

//vCurRect 该变量在 DbGrid 的 DrawColumnCell 事件中获得

{procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

vCurRect:=Rect;//vCurRect 在实现部分定义

end;}

2003-12-22 10:12:55 DbGrid 控件的标题栏弹出菜单 DbGrid 控件的标题栏弹出菜单

procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var

CurPost:TPoint;

begin

GetCursorPos(CurPost);// 获得鼠标当前坐标

if (y<=17) and (x<=vCurRect.Right) then

begin

if button=mbright then

begin

PmTitle.Popup(CurPost.x,CurPost.y);

end;

//vCurRect 该变量在 DbGrid 的 DrawColumnCell 事件中获得

{procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

vCurRect:=Rect;//vCurRect 在实现部分定义

end;}

2003-12-22 10:14:26 把 DBGrid 输出到 Excel 表格（支持多 Sheet ） {

功能描述：把 DBGrid 输出到 Excel 表格（支持多 Sheet ）

调用格式： CopyDbDataToExcel([DBGrid1, DBGrid2]);

}

procedure CopyDbDataToExcel(Args: array of const);

var

iCount, jCount: Integer;

XLApp: Variant;

Sheet: Variant;

I: Integer;

begin

Screen.Cursor := crHourGlass;

if not VarIsEmpty(XLApp) then

begin

XLApp.DisplayAlerts := False;

XLApp.Quit;

VarClear(XLApp);

end;

try

XLApp := CreateOleObject(‘Excel.Application‘);

except

Screen.Cursor := crDefault;

Exit;

end;

XLApp.WorkBooks.Add;

XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do

begin

XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;

Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];

if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then

begin

Screen.Cursor := crDefault;

Exit;

end;

TDBGrid(Args[I].VObject).DataSource.DataSet.first;

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[1, iCount + 1] :=

TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;

while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do

begin

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[jCount + 1, iCount + 1] :=

TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);

TDBGrid(Args[I].VObject).DataSource.DataSet.Next;

end;

XlApp.Visible := True;

end;

Screen.Cursor := crDefault;

end;

2004-1-2 11:26:02 自制精美易用的 DBGrid 【陈大峰】看了以上这么多的技巧和方法，想必大家未免会有一种冲动吧－自己动手做一个 DBGrid ，下面就介绍一种自制 DBGrid 的方法啦。

Delphi 中的 TDBGrid 是一个使用频率很高的 VCL 元件。 TDBGrid 有许多优良的特性，例如它是数据绑定的，能够定义功能强大的永久字段，事件丰富等，特别是使用非常简单。但是，与 FoxPro 、 VB 、 PB 中的 DBGrid 相比就会发现， TDBGrid 也有明显的缺陷：它的键盘操作方式非常怪异难用。虽然很多人都通过编程把回车键转换成 Tab 键来改进 TDBGrid 的输入方式，但是仍然不能很好地解决问题，这是为什么呢？本文将对造成这种缺陷的根本原因进行分析，并在此基础上制作一个输入极其简便、界面风格类似 Excel 的 DBGridPro 元件。

DBGrid 的格子（ Cell ）有四种状态：输入状态（有输入光标，可以输入，记作状态 A1 ）；下拉状态（弹出了下拉列表，可以选择，记作状态 A2 ）；高亮度状态（没有输入光标，可以输入，记作状态 B ）；显示状态（不能输入，记作状态 C ）。 DBGrid 接受的控制键有回车， Tab ， Esc ，以及方向键。据此可以画出每个 Cell 的状态转换图：

不难看出，当用户移动输入焦点时，对不同的移动方向要用不同的操作方法，甚至可能必须使用多个不同的键或借助鼠标来完成一个操作。当有下拉列表和要斜向移动的时候这种问题尤为明显。因此，输入困难的根本原因是其状态图过于复杂和不一致。基于这种认识，我们可以对 DBGrid 作三点改造：

改造 1 ：显然 B 状态是毫无意义的，应该去掉。这意味着焦点每进入一个新的 Cell ，就立即进入编辑状态，而不要再按回车了。每个进入状态 B 的 Cell 都需要重新绘制，因此我们可以在绘制动作中判断是否有状态为 gdFocused 的 Cell ，若有则设置 EditorMode 为真。值得注意的是， TDBGrid 用来画 Cell 的函数 DefaultDrawColumnCell 并不是虚函数，因此不能通过继承改变其行为，而只能使用其提供的事件 OnDrawColumnCell 来插入一些动作。在 DBGridPro 中，这一点是通过实现显示事件 OnDrawColumnCell 来实现的。但是这样一来，外部对象就不能使用该事件了，所以提供了一个 OnOwnDrawColumnCell 事件来替代它。见代码中的 Create 和 DefaultDrawColumnCell 函数。

改造 2 ：控制键应该简化，尽量增加每个控制键的能力。在 DBGridPro 中，强化了方向键和回车键的功能：当光标在行末行首位置时，按方向键就能跳格；回车能横向移动输入焦点，并且还能弹出下拉列表（见改造 3 ）。在实现方法上，可以利用键盘事件 API （ keybd_event ）来将控制键转换成 TDBGrid 的控制键（如在编辑状态中回车，则取消该事件并重新发出一个 Tab 键事件）。当监测到左右方向键时，通过向编辑框发送 EM_CHARFROMPOS 消息判断编辑框中的光标位置，以决定是否应该跳格。见代码中的 DoKeyUped 函数。

改造 3 ：简化下拉类型 Cell 的输入方式。在 DBGridPro 中，用户可以用回车来弹出下拉列表。这种方式看起来可能会造成的回车功能的混淆，但是只要处理得当，用户会觉得非常方便：当进入下拉类型的 Cell 之后，如果用户直接键入修改，则按回车进入下一格；否则弹出下拉列表，选择之后再按回车时关闭下拉列表并立即进入下一格。见代码中的 DoKeyUped 函数和 DefaultDrawColumnCell 函数。

一番改造之后，用户输入已经非常方便了，但是又带来了新的问题：在 TDBGrid 中，用户可以通过高亮度的 Cell 很快知道焦点在哪里，而 DBGridPro 中根本不会出现这种 Cell ，所以用户可能很难发现输入焦点！一种理想的方法是像 Excel 一样在焦点位置处放一个黑框 -- 这一点是可以实现的（如图 2 ）。

Windows 中提供了一组 API ，用于在窗口上建立可接受鼠标点击事件的区域（ Region ）。多个 Region 可以以不同的方式组合起来，从而得到 " 异型 " 窗口，包括空心窗口。 DBGridPro 就利用了这个功能。它在内部建立了一个黑色的 Panel ，然后在上面设置空心的 Region ，并把它 " 套 " 在有输入焦点的 Cell 上，这样用户就能看到一个醒目的边框了。

好事多磨，现在又出现了新的问题：当 Column 位置或宽度改变时，其边框必须同步变化。仅利用鼠标事件显然不能完全解决这个问题，因为在程序中也可以设置 Column 的宽度；用事件 OnDrawColumnCell 也不能解决（宽度改变时并不触发该事件）。幸运的是， TDBGrid 中的输入框实际上是一个浮动在它上面的 TDBGridInplaceEdit （继承自 TInplaceEdit ），如果我们能监测到 TDBGridInplaceEdit 在什么时候改变大小和位置，就可以让边框也跟着改变了。要实现这一点，用一个从 TDBGridInplaceEdit 继承的、处理了 WM_WINDOWPOSCHANGED 消息的子类来替换原来的 TDBGridInplaceEdit 将是最简单的办法。通过查看源代码发现，输入框由 CreateEditor 函数创建的，而这是个虚函数 -- 这表明 TDBGrid 愿意让子类来创建输入框，只要它是从 TInplaceEdit 类型的。从设计模式的角度来看，这种设计方法被称为 " 工厂方法 " （ Factory Method ），它使一个类的实例化延迟到其子类。看来现在我们的目的就要达到了。

不幸的是， TDBGridInplaceEdit 在 DBGrids.pas 中定义在 implement 中（这样外部文件就无法看到其定义了），因此除非把它的代码全部拷贝一遍，或者直接修改 DBGrids.pas 文件（显然这前者不可取；后者又会带来版本兼容性问题），我们是不能从 TDBGridInplaceEdit 继承的。难道就没有好办法了吗？当然还有：我们可以利用 TDBGridInplaceEdit 的可读写属性 WindowProc 来捕获 WM_WINDOWPOSCHANGED 消息。 WindowProc 实际上是一个函数指针，它指向的函数用来处理发到该窗口元件的所有消息。于是，我们可以在 CreateEditor 中将创建出的 TDBGridInplaceEdit 的 WndProc 替换成我们自己实现的勾挂函数的指针，从而实现和类继承相同的功能。这样做的缺点是破坏了类的封装性，因为我们不得不在 DBGridPro 中处理属于 TDBGridInplaceEdit 的工作。当然，可能还有其他更好的方法，欢迎读者提出建议。

至此， TDBGrid 已经被改造成一个操作方便、界面美观的 DBGridPro 了，我们可以把它注册成 VCL 元件使用。以下是它的源代码：

unit DBGridPro;

interface

uses

Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids, ExtCtrls, richEdit, DBCtrls, DB;

type TCurCell = Record { 当前焦点 Cell 的位置 }

X : integer; { 有焦点 Cell 的 ColumnIndex}

Y : integer; { 有焦点 Cell 所在的纪录的纪录号 }

tag : integer; { 最近进入该 Cell 后是否弹出了下拉列表 }

r : TRect; { 没有使用 }

end;

type

TDBGridPro = class(tcustomdbgrid)

private

hr,hc1 : HWND; { 创建空心区域的 Region Handle}

FPan : TPanel; { 显示黑框用的 Panel}

hInplaceEditorWndProc : TWndMethod; { 编辑框原来的 WindowProc}

{ 勾挂到编辑框的 WindowProc}

procedure InPlaceEditorWndProcHook(var msg : TMessage);

procedure AddBox; { 显示边框 }

{ 实现 TCustomDBGrid 的 OnDrawColumnCell 事件 }

procedure DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

{ 处理键盘事件 }

procedure DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState);

protected

curCell : TCurCell; { 记录当前有焦点的 Cell}

FOwnDraw : boolean; { 代替 TCustomDBGrid.DefaultDrawing}

FOnDraw : TDrawColumnCellEvent; { 代替 TCustomDBGrid.OnDrawColumnCell}

function CreateEditor : TInplaceEdit; override;

procedure KeyUp(var Key: Word; Shift: TShiftState); override;

procedure DefaultDrawColumnCell(const Rect: TRect;DataCol: Integer; Column: TColumn; State: TGridDrawState); overload;

public

constructor Create(AOwner : TComponent); override;

destructor Destroy; override;

published

property Align;

property Anchors;

property BiDiMode;

property BorderStyle;

property Color;

property Columns stored False; //StoreColumns;

property Constraints;

property Ctl3D;

property DataSource;

property OwnDraw : boolean read FOwnDraw write FOwnDraw default false;

property DragCursor;

property DragKind;

property DragMode;

property Enabled;

property FixedColor;

property Font;

property ImeMode;

property ImeName;

property Options;

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 OnOwnDrawColumnCell : TDrawColumnCellEvent read FOnDraw write FOnDraw;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEditButtonClick;

property OnEndDock;

property OnEndDrag;

property OnEnter;

property OnExit;

property OnKeyup;

property OnKeyPress;

property OnKeyDown;

property OnMouseDown;

property OnMouseMove;

property OnMouseUp;

property OnStartDock;

property OnStartDrag;

property OnTitleClick;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Data Controls', [TDBGridPro]);

end;

{ TDBGridPro }

procedure TDBGridPro.AddBox;

var

p,p1 : TRect;

begin

GetWindowRect(InPlaceEditor.Handle,p);

GetWindowRect(FPan.Handle,p1);

if (p.Left=p1.Left) and (p.Top=p1.Top) and (p.Right=p1.Right) and (p.Bottom=p1.Bottom) then exit;

if hr<>0 then DeleteObject(hr);

if hc1<>0 then DeleteObject(hc1);

{ 创建内外两个 Region}

hr := CreateRectRgn(0,0,p.Right-p.Left+4,p.Bottom-p.Top+4);

hc1:= CreateRectRgn(2,2,p.Right-p.Left+2,p.Bottom-p.Top+2);

{ 组合成空心 Region}

CombineRgn(hr,hc1,hr,RGN_XOR);

SetWindowRgn(FPan.Handle,hr,true);

FPan.Parent := InPlaceEditor.Parent;

FPan.ParentWindow := InPlaceEditor.ParentWindow;

FPan.Height := InPlaceEditor.Height+4;

FPan.Left := InPlaceEditor.Left-2;

FPan.Top :=InPlaceEditor.Top-2;

FPan.Width := InPlaceEditor.Width+4;

FPan.BringToFront;

end;

constructor TDBGridPro.Create(AOwner: TComponent);

begin

inherited;

{ 创建作为边框的 Panel}

FPan := TPanel.Create(nil);

FPan.Parent := Self;

FPan.Height := 0;

FPan.Color := 0;

FPan.Ctl3D := false;

FPan.BevelInner := bvNone;

FPan.BevelOuter := bvNone;

FPan.Visible := true;

DefaultDrawing := false;

OnDrawColumnCell := DoOwnDrawColumnCell;

OnOwnDrawColumnCell := nil;

curCell.X := -1;

curCell.Y := -1;

curCell.tag := 0;

hr := 0;

hc1 := 0;

end;

function TDBGridPro.CreateEditor: TInplaceEdit;

begin

result := inherited CreateEditor;

hInPlaceEditorWndProc := result.WindowProc;

result.WindowProc := InPlaceEditorWndProcHook;

end;

procedure TDBGridPro.DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

{ 如果要画焦点，就让 DBGrid 进入编辑状态 }

if (gdFocused in State) then

begin

EditorMode := true;

AddBox;

{ 如果是进入一个新的 Cell ，全选其中的字符 }

if (curCell.X <> DataCol) or (curCell.Y <> DataSource.DataSet.RecNo)

then begin

curCell.X := DataCol;

curCell.Y := DataSource.DataSet.RecNo;

curCell.tag := 0;

GetWindowRect(InPlaceEditor.Handle,curCell.r);

SendMessage(InPlaceEditor.Handle,EM_SETSEL,0,1000);

end;

end else { 正常显示状态的 Cell}

TCustomDBGrid(Self).DefaultDrawColumnCell(Rect,DataCol,Column,State);

end;

destructor TDBGridPro.Destroy;

begin

FPan.Free;

inherited;

end;

procedure TDBGridPro.DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState);

var

cl : TColumn;

begin

cl := Columns[SelectedIndex];

case Key of

VK_RETURN:

begin

{ 一个 Column 为下拉类型，如果：

1 该 Column 的按钮类型为自动类型

2 该 Column 的 PickList 非空，或者其对应的字段是 lookup 类型 }

if (cl.ButtonStyle=cbsAuto) and ((cl.PickList.Count>0) or (cl.Field.FieldKind=fkLookup)) and (curCell.tag = 0) and not (ssShift in Shift) then

begin

{ 把回车转换成 Alt+ 向下弹出下拉列表 }

Key := 0;

Shift := [ ];

keybd_event(VK_MENU,0,0,0);

keybd_event(VK_DOWN,0,0,0);

keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0);

keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0);

curCell.tag := 1;

exit;

end;

{ 否则转换成 Tab}

Key := 0;

keybd_event(VK_TAB,0,0,0);

keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);

end;

VK_RIGHT :

begin

{ 获得编辑框中的文字长度 }

i := GetWindowTextLength(InPlaceEditor.Handle);

{ 获得编辑框中的光标位置 }

GetCaretPos(p);

p.x := p.X + p.Y shr 16;

j := SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X);

if (i=j) then { 行末位置 }

begin

Key := 0;

keybd_event(VK_TAB,0,0,0);

keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);

end;

VK_LEFT:

begin

GetCaretPos(p);

p.x := p.X + p.Y shr 16;

if SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X)=0 then

begin { 行首位置 }

Key := 0;

keybd_event(VK_SHIFT,0,0,0);

keybd_event(VK_TAB,0,0,0);

keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);

keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0);

end;

else begin { 记录用户是否作了修改 }

if (Columns[SelectedIndex].PickList.Count>0) and (curCell.tag = 0) then

if SendMessage(InPlaceEditor.Handle,EM_GETMODIFY,0,0)=1 then

curCell.tag := 1;

end;

procedure TDBGridPro.DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

if FOwnDraw=false then DefaultDrawColumnCell(Rect,DataCol,Column,State);

if @OnOwnDrawColumnCell<>nil then OnOwnDrawColumnCell(Sender,Rect,DataCol, Column,State);

end;

procedure TDBGridPro.InPlaceEditorWndProcHook(var msg: TMessage);

var m : integer;

begin

m := msg.Msg;

{=inherited}

hInplaceEditorWndProc(msg);

{ 如果是改变位置和大小，重新加框 }

if m=WM_WINDOWPOSCHANGED then AddBox;

end;

procedure TDBGridPro.KeyUp(var Key: Word; Shift: TShiftState);

begin

inherited;

DoKeyUped(Self,Key,Shift);

end;

end.

{ 以上代码在 Windows2000 ， Delphi6 上测试通过 }

2004-3-20 14:34:24 打印 TDBGrid 内容

procedure PrintDbGrid(DataSet:TDataSet;DbGrid:TDbGrid;Title:String);

var

PointX,PointY:integer;

ScreenX:integer;

i,lx,ly:integer;

px1,py1,px2,py2:integer;

RowPerPage,RowPrinted:integer;

ScaleX:Real;

THeight:integer;

TitleWidth:integer;

SumWidth:integer;

PageCount:integer;

SpaceX,SpaceY:integer;

RowCount:integer;

begin

PointX:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSX)/2.54);

PointY:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSY)/2.54);

ScreenX:=Round(Screen.PixelsPerInch/2.54);

ScaleX:=PointX/ScreenX;

RowPrinted:=0;

SumWidth:=0;

printer.BeginDoc;

With Printer.Canvas do

begin

DataSet.DisableControls;

DataSet.First ;

THeight:=Round(TextHeight(' 我 ')*1.5);// 设定每行高度为字符高的 1.5 倍

SpaceY:= Round(TextHeight(' 我 ')/4);

SpaceX:=Round(TextWidth(' 我 ')/4);

RowPerpage:=Round((printer.PageHeight-5*PointY)/THeight); // 上下边缘各 2 厘米

ly:=2*PointY;

PageCount:=0;

while not DataSet.Eof do

begin

if (RowPrinted=RowPerPage) or (RowPrinted=0) then

begin

if RowPrinted<>0 then

Printer.NewPage;

RowPrinted:=0;

PageCount:=PageCount+1;

Font.Name:=' 宋体 ';

Font.size:=16;

Font.Style:=Font.Style+[fsBold];

lx:=Round((Printer.PageWidth-TextWidth(Title))/2);

ly:=2*PointY;

TextOut(lx,ly,Title);

Font.Size:=11;

Font.Style:=Font.Style-[fsBold];

lx:=Printer.PageWidth-5*PointX;

ly:=Round(2*PointY+0.2*PointY);

if RowPerPage*PageCount>DataSet.RecordCount then

RowCount:=DataSet.RecordCount

else

RowCount:=RowPerPage*PageCount;

TextOut(lx,ly,' 第 '+IntToStr(RowPerPage*(PageCount-1)+1)+'-'+IntToStr(RowCount)+' 条，共 '+IntToStr(DataSet.RecordCount)+' 条 ');

lx:=2*PointX;

ly:=ly+THeight*2;

py1:=ly-SpaceY;

if RowCount=DataSet.RecordCount then

py2:=py1+THeight*(RowCount-RowPerPage*(PageCount-1)+1)

else

py2:=py1+THeight*(RowPerPage+1);

SumWidth:=lx;

for i:=0 to DBGrid.Columns.Count-1 do

begin

px1:=SumWidth-SpaceX;

px2:=SumWidth;

MoveTo(px1,py1);

LineTo(px2,py2);

TitleWidth:=TextWidth(DBGrid.Columns[i].Title.Caption);

lx:=Round(SumWidth+(DBGrid.Columns[i].width*scaleX-titleWidth)/2);

TextOut(lx,ly,DBGrid.Columns[i].Title.Caption);

SumWidth:=Round(SumWidth+DBGrid.Columns[i].width*scaleX)+SpaceX*2;

end;

px1:=SumWidth; // 画最后一条竖线

px2:=SumWidth;

MoveTo(px1,py1);

LineTo(px2,py2);

px1:=2*PointX; // 画第一条横线

px2:=SumWidth;

py1:=ly-SpaceY;

py2:=ly-SpaceY;

MoveTo(px1,py1);

LineTo(px2,py2);

py1:=py1+THeight;

py2:=py2+THeight;

MoveTo(px1,py1);

LineTo(px2,py2);

end;

lx:=2*PointX;

ly:=ly+THeight;

px1:=lx;

px2:=SumWidth;

py1:=ly-SpaceY+THeight;

py2:=ly-SpaceY+THeight;

MoveTo(px1,py1);

LineTo(px2,py2);

for i:=0 to DBGrid.Columns.Count-1 do

begin

TextOut(lx,ly,DataSet.FieldByname(DBGrid.Columns[i].Fieldname).AsString);

lx:=Round(lx+DBGrid.Columns[i].width*ScaleX+SpaceX*2);

end;

RowPrinted:=RowPrinted+1;

DataSet.next;

end;

DataSet.first;

DataSet.EnableControls;

end;

printer.EndDoc;

end;

打印 StringGrid 内容

Procedure TACDListerMain.PrintTable;

Var

margins: TRect;

spacing: Integer;

Cols: TList;

Dlg: TPrintProgressDlg;

Procedure SetColumnWidth;

Var

i, k, w: Integer;

Begin

Printer.Canvas.Font.Style := [ fsBold ];

For i := 0 To Pred( Grid.ColCount ) Do

Cols.Add( Pointer( Printer.Canvas.TextWidth( Grid.Cells[ i,0 ] )));

Printer.Canvas.Font.Style := [];

For i := 1 To Pred( Grid.RowCount ) Do

For k := 0 To Pred( Grid.ColCount ) Do Begin

w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] );

If w > Integer( Cols[ k ] ) Then

Cols[ k ] := Pointer( w );

End; { For }

w := 2 * Printer.Canvas.Font.PixelsPerInch div 3;

margins :=

Rect( w, w, Printer.PageWidth-w, Printer.PageHeight - w );

spacing := Printer.Canvas.Font.PixelsPerInch div 10;

w := 0;

For i := 0 To Pred(cols.Count) Do

w := w + Integer( cols[ i ] ) + spacing;

w := w - spacing;

If w > (margins.right-margins.left ) Then Begin

w := w - (margins.right-margins.left );

cols[ cols.Count-2 ] :=

Pointer( Integer( cols[ cols.Count-2 ] ) - w );

End; { If }

w:= 0;

For i := 0 To Pred(cols.Count) Do

w := w + Integer( cols[ i ] ) + spacing;

margins.right := w - spacing + margins.left;

End; { SetColumnWidth }

Procedure DoPrint;

Var

i: Integer;

y: Integer;

Procedure DoLine(lineno: Integer);

Var

x, n: Integer;

r: TRect;

th: Integer;

Begin

If Length(Grid.Cells[0,lineno]) = 0 Then Exit;

x:= margins.left;

With Printer.Canvas Do Begin

th := TextHeight( ' 膟 ' );

For n := 0 To Pred( Cols.Count ) Do Begin

r := Rect( 0, 0, Integer(Cols[ n ]), th);

OffsetRect( r, x, y );

TextRect( r, x, y, Grid.Cells[ n, lineno ] );

x := r.right + spacing;

End; { For }

End; { With }

y := y + th;

End; { DoLine }

Procedure DoHeader;

Begin

y:= margins.top;

With Printer.Canvas Do Begin

Font.Style := [ fsBold ];

DoLine( 0 );

Pen.Width := Font.PixelsPerInch div 72;

Pen.Color := clBlack;

MoveTo( margins.left, y );

LineTo( margins.right, y );

Inc( y, 2 * Pen.Width );

Font.Style := [ ];

End; { With }

End; { DoHeader }

Begin

y:= 0;

For i := 1 To Pred( Grid.RowCount ) Do Begin

Dlg.Progress( i );

Application.ProcessMessages;

If FPrintAborted Then Exit;

If y = 0 Then

DoHeader;

DoLine( i );

If y >= margins.bottom Then Begin

Printer.NewPage;

y:= 0;

End; { If }

End; { For }

End; { DoPrint }

Begin

FPrintAborted := False;

Dlg := TPrintProgressDlg.Create( Application );

With Dlg Do

try

OnAbort := PrintAborted;

Display( cPrintPreparation );

SetProgressRange( 0, Grid.RowCount );

Show;

Application.ProcessMessages;

Printer.Orientation := poLandscape;

Printer.BeginDoc;

Cols:= Nil;

try

Cols:= TLIst.Create;

Printer.Canvas.Font.Assign( Grid.Font );

SetColumnWidth;

Display( cPrintProceeding );

Application.ProcessMessages;

DoPrint;

finally

Cols.Free;

If FPrintAborted Then

Printer.Abort

Else

Printer.EndDoc;

end;

finally

Close;

End; { With }

End; { TACDListerMain.PrintTable }

2004-3-23 9:30:43 在 DELPHI 中利用 API 实现网格内组件的嵌入 --------------------------------------------------------------------------------

　　 Delphi 中向 TDBGrid 添加组件是一件十分麻烦的事情。笔者在这里向大家介绍一种利用 WIN32 API 函数在 TDBGRID 中嵌入 CHECKBOX 组件的方法。

　　 TDBGrid 部件是用于显示和编辑数据库表中记录信息的重要部件，它是我们在程序设计过程中要经常使用的一个强有力的工具。 TDBGrid 具有很多重要的属性，我们可以在程序设计阶段和程序运行过程中进行设置。 TDBGrid 部件中有很多重要的属性，我们在这里重点介绍 Option 属性和 DefaultDrawing 属性，其他属性及其设置方法请参看联机帮助文件。

　　 Options 属性：它是 TDBGrid 部件的一个扩展属性，在程序设计阶段设置 Options 属性可以控制 TDBGrid 部件的显示特性和对事件的响应特性。

　　 DefalultDrawing 属性：该属性是布尔型属性，它用于控制网格中各网格单元的绘制方式。在缺省情况下，该属性的值为 True ，也就是说 Delphi 使用网格本身缺省的方法绘制网格中各网格单元，并填充各网格单元中的内容，各网格单元中的数据根据其对应的字段部件的 DisplayFormat 属性和 EidtFormat 属性进行显示和绘制。如果 DefaulDrawing 属性被设置为 False ， Delphi 不会自动地绘制网格中各网格单元和网格单元中的数据，用户必须自己为 TDBGrid 部件的 OnDrawDataCell 事件编写相应的程序以用于绘制各网格单元和其中的数据。

　　需要注意的是，当一个布尔字段得到焦点时， TDBGrid.Options 中的 gdEditing 属性不能被设置成为可编辑模式。另外， TDBGrid.DefaultDrawing 属性不要设置为 FALSE ，否则，就不能得到网格中画布属性的句柄。

　　程序设计开始时就应考虑：需要设定一变量来存储原始的 TDBGrid.Options 的所有属性值。这样，当一 boolean 字段所在栏得到焦点时将要关闭 TDBGrid.Options 中 gdEditing 的可编辑模式。与此相对应，若该栏失去焦点时，就要重新恢复原始的 TDBGrid.Options 的所有属性值。

　　在实例中可以通过鼠标点击或敲打空格键改变布尔值，这样就需要触发 TDBGrid.OnCellClick 事件和 TDBGrid.OnKeyDown 事件。因为这两个事件都是改变单元格中逻辑字段的布尔值，所以为了减少代码的重复最好创建一个私有过程（ SaveBoolean; ）来完成逻辑值的输入，以后，在不同的事件中调用此过程即可。

　　对 TDBGrid.OnDrawColumnCell 事件的处理是整个程序的关键。处理嵌入组件的显示的传统方法是：在表单上实际添加组件对象，然后对组件的位置属性与网格中单元格的位置属性进行调整，以达到嵌入的视觉效果。这种方法虽然可行但代码量大，实际运行时控制性很差。笔者采用的方法是充分利用 WIN32 API 函数： DrawFrameControl() ，由于此函数可以直接画出 Checkbox 组件，所以就无须在表单中实际添加组件。如何使用 API 函数： DrawFrameControl() 是本程序技巧所在。

　　在 TDBGrid.OnDrawColumnCell 事件中，我想大家会注意到：设定一个整型数组常数，而这个返回的整数值是与布尔值相一致的，如果字段是逻辑字段，则只将其布尔值放入数组中，提供给 DrawFrameControl() 函数中的状态参数进行调用，从而实现了 Checkbox 组件在网格中的嵌入效果。

　　源代码如下：

　　 type

　　 TForm1 = class(TForm)

　　　　 DataSource1: TDataSource;

　　　　 Table1: TTable;

　　　　 DBGrid1: TDBGrid;

　　　　 procedure DBGrid1DrawColumnCell(Sender: TObject;

　　　　　　　　　　 const Rect: TRect; DataCol: Integer;

　　　　　　　　　　 Column: TColumn; State: TGridDrawState);

　　　　 procedure DBGrid1ColEnter(Sender: TObject);

　　　　 procedure DBGrid1ColExit(Sender: TObject);

　　　　 procedure DBGrid1CellClick(Column: TColumn);

　　　　 procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;

　　　　　　　　　　 Shift: TShiftState);

　　 private

　　　　 { Private declarations }

　　　　 OriginalOptions : TDBGridOptions;

　　　　 procedure SaveBoolean;

　　 public

　　　　 { Public declarations }

　　 end;

　　 {...}

　　 procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;

　　　　　　　　　　 const Rect: TRect; DataCol: Integer;

　　　　　　　　　　 Column: TColumn; State: TGridDrawState);

　　 const

　　 // 这个整数值将按照布尔值返回，并送入数组

　　 CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,DFCS_BUTTONCHECK or DFCS_CHECKED);

　　 begin

　　 // 确保只有在逻辑字段才能插入组件

　　 if Column.Field.DataType = ftBoolean then

　　 begin

　　　　 DBGrid1.Canvas.FillRect(Rect);

　　　　 DrawFrameControl(DBGrid1.Canvas.Handle,

　　　　　　　　　　　　 Rect,

　　　　　　　　　　　　 DFC_BUTTON,

　　　　　　　　　　　　 CtrlState[Column.Field.AsBoolean]);

　　 end;

　　 procedure TForm1.DBGrid1ColEnter(Sender: TObject);

　　 begin

　　 // 确保该栏是逻辑字段

　　 if DBGrid1.SelectedField.DataType = ftBoolean then

　　 begin

　　　　 OriginalOptions := DBGrid1.Options;

　　　　 DBGrid1.Options := DBGrid1.Options - [dgEditing];

　　 end;

　　 procedure TForm1.DBGrid1ColExit(Sender: TObject);

　　 begin

　　 // 确保该栏是逻辑字段

　　 if DBGrid1.SelectedField.DataType = ftBoolean then

　　　　 DBGrid1.Options := OriginalOptions;

　　 end;

　　 procedure TForm1.DBGrid1CellClick(Column: TColumn);

　　 begin

　　 // 确保该栏是逻辑字段

　　 if DBGrid1.SelectedField.DataType = ftBoolean then

　　　　 SaveBoolean();

　　 end;

　　 procedure TForm1.DBGrid1KeyDown(Sender: TObject;

　　　　　　　　　　　　 var Key: Word; Shift: TShiftState);

　　 begin

　　 // 确保该栏是逻辑字段和空格键在键盘中被敲击

　　 if ( Key = VK_SPACE ) and

　　　　 ( DBGrid1.SelectedField.DataType = ftBoolean ) then

　　　　 SaveBoolean();

　　 end;

　　 procedure TForm1.SaveBoolean;

　　 begin

　　 DBGrid1.SelectedField.Dataset.Edit;

　　 DBGrid1.SelectedField.AsBoolean :=not DBGrid1.SelectedField.AsBoolean;

　　 DBGrid1.SelectedField.Dataset.Post;

　　 end;

dbgrid使用大全(delphi)

你可能感兴趣的:(数据库,table,Integer,Delphi,dataset,网格)