Dbgrid使用技巧(下)

二、建立项目，实现功能
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;
　　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;
  end;
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;
    end;
  except
  end;
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;

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

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


二、DBGrid 中 的 查 找 字 段
    所谓查找字段(LookUp Field)，即 DBGrid中的某个关键字段的数值来源于另外一个数据库的相应字段。运用查找字段技术，不仅可以有效的避免输入错误，而且 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 按钮。

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

    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-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;
    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;
 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;
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
支持：CoolSlob@163.com
调用格式：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;
  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;
  end;
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;
  end;
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;
  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;
  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;
  end;
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;
　　end;

　　procedure TForm1.DBGrid1ColEnter(Sender: TObject);
　　begin
　　 // 确保该栏是逻辑字段
　　 if DBGrid1.SelectedField.DataType = ftBoolean then
　　 begin
　　　　OriginalOptions := DBGrid1.Options;
　　　　DBGrid1.Options := DBGrid1.Options - [dgEditing];
　　 end;
　　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;