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.WParamL=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@
调用格式：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(linen 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;

　　以上源程序在PWIN+DELPHI5.0环境调试通过，可以直接引用。
  

ding

楼主直接弄上来个文本附件多好啊 粘贴的我手直酸