DBGrid 应用全书

{***********************************************************************}
{*在 Delphi 语言的数据库编程中，DBGrid 是显示数据的主要手段之一。
{*但是 DBGrid 缺省的外观未免显得单调和缺乏创意。其实，我们完全可
{*以在我们的程序中通过编程来达到美化DBGrid 外观的目的。通过编程，
{*我们可以改变 DBGrid 的表头、网格、网格线的前景色和背景色，以及
{*相关的字体的大小和风格。
{* 转自：jinjazz 落寞刺客
{*DBGrid 应用全书[感谢archonwang]
{*airii的blog上看到的文章,动了动手
{*原文http://www.delphibbs.com/keylife/iblog_show.asp?xid=4091
{***********************************************************************}


1、{外观}

{======================
 表头、隔行、网格
 ======================}
procedure TForm1.DBGridDrawColumnCell_A(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var i :integer;
begin
if gdSelected in State then Exit;
//定义表头的字体和背景颜色：
  for i :=0 to (Sender as TDBGrid).Columns.Count-1 do
  begin
    (Sender as TDBGrid).Columns[i].Title.Font.Name :='宋体'; //字体
    (Sender as TDBGrid).Columns[i].Title.Font.Size :=9; //字体大小
    (Sender as TDBGrid).Columns[i].Title.Font.Color :=$000000ff; //字体颜色(红色)
    (Sender as TDBGrid).Columns[i].Title.Color :=$0000ff00; //背景色(绿色)
  end;
//隔行改变网格背景色：
if (Sender as TDBGrid).DataSource.DataSet.RecNo mod 2 = 0 then
    (Sender as TDBGrid).Canvas.Brush.Color := clInfoBk //定义背景颜色
else
    (Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); //定义背景颜色
//定义网格线的颜色：
    TDBGrid(sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
with (Sender as TDBGrid).Canvas do //画 cell 的边框
begin
    Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
    Pen.Color := $0000ff00; //定义画笔颜色(绿色)
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画绿色的竖线
end;
end;


{======================
  焦点单元变色
  =====================}
procedure TForm1.DBGridDrawColumnCell_B(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
    TDBGrid(sender).Canvas.Brush.color:=clRed; //当前行以红色显示，其它行使用背景的浅绿色
    TDBGrid(sender).Canvas.pen.mode:=pmmask;
    TDBGrid(sender).DefaultDrawColumnCell (Rect,DataCol,Column,State);
end;

{====================
  单元字体变色
 ===================}
procedure TForm1.DBGridDrawColumnCell_C(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if copy(TDbgrid(sender).DataSource.DataSet.fieldbyname(column.Title.Caption).AsString,1,1)='A' then
  TDBGrid(sender).Canvas.Font.Color := clRed
else
  if ((State=[gdSelected,gdFocused])) then
   TDBGrid(sender).Canvas.Font.Color := clWhite
   else
 TDBGrid(sender).Canvas.Font.Color := clBlack;
 TDBGrid(sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

{=======================
  纵向斑马线
  =======================}
procedure TForm1.DBGridDrawColumnCell_D(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  Case DataCol Mod 2 = 0 of
    True: DbGrid1.Canvas.Brush.Color:= clinfobk; //偶数列用蓝色
    False: DbGrid1.Canvas.Brush.Color:= clMoneygreen; //奇数列用浅绿色
  End;
    if ((State=[gdSelected,gdFocused])) then
  TDBGrid(sender).Canvas.Font.Color := clblue;
  TDBGrid(sender).Canvas.pen.mode:=pmmask;
  DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
end;

{============================
  突出行显示
  ==========================}
procedure TForm1.DBGridDrawColumnCell_E(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  Tdbgrid(sender).Color:=clAqua;
  Tdbgrid(sender).Options:=Tdbgrid(sender).Options +[dgRowSelect];
  if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
  DbGrid1.Canvas.Brush.color:=clRed; //当前行以红色显示，其它行使用背景的浅绿色
  DbGrid1.Canvas.pen.mode:=pmmask;
  DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
end;

{=============================
  突出行列显示
  ===========================}
procedure TForm1.DBGridDrawColumnCell_F(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  Tdbgrid(sender).Color:=clAqua;
  Tdbgrid(sender).Options:=Tdbgrid(sender).Options +[dgRowSelect];
  if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
  begin
    Case DataCol Mod 2 = 0 of
      True : DbGrid1.Canvas.Brush.color:=clRed; //当前选中行的偶数列显示红色
      False: DbGrid1.Canvas.Brush.color:=clblue; //当前选中行的奇数列显示蓝色
    end;
    DbGrid1.Canvas.pen.mode:=pmmask;
    DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
  end;
end;

{============================
    眼花缭乱 @_@
  ===========================}
procedure TForm1.DBGridDrawColumnCell_G(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
Case Table1.RecNo mod 2 = 0 of//根据数据集的记录号进行判断
True : DbGrid1.Canvas.Brush.color:=Clinfobk; //偶数行用浅绿色显示
False: DbGrid1.Canvas.Brush.color:= clmoneygreen; //奇数行用蓝色表示
end;
If ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
Case DataCol mod 2 = 0 of
True : DbGrid1.Canvas.Brush.color:=clRed; //当前选中行的偶数列用红色
False: DbGrid1.Canvas.Brush.color:= clGreen; //当前选中行的奇数列用绿色表示
end;
DbGrid1.Canvas.pen.mode:=pmMask;
DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
end;

{图像}
procedure TForm1.DBGridDrawColumnCell_H(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
Bmp: TBitmap;
begin
if (Column.Field.DataType = ftBLOB) or (Column.Field.DataType = ftGraphic) then
begin
 Bmp:=TBitmap.Create;
 try
 Bmp.Assign(Column.Field);
 DBGrid1.Canvas.StretchDraw(Rect,Bmp);
 Bmp.Free;
Except
 Bmp.Free;
end;
end;
end;

{============
 自动调整列宽
 =============}
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.DBGridDrawColumnCell_I(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
   DBGridRecordSize(Column);
end;

{增加右键菜单}
procedure TForm1.DBGridDrawColumnCell_J(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  vCurRect:=Rect;//vCurRect在实现部分定义
end;


procedure TForm1.DBGridMouseDown(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;

2、其他技巧

{============
  文字也可以托放
  ============}
procedure TForm1.DBGridDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
   accept:=true;
end;

procedure TForm1.DBGridDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Source<>Edit1 then exit;
  with Sender as TDbGrid do begin
    Perform(wm_LButtonDown,0,MakeLong(x,y));
    PerForm(WM_LButtonUp,0,MakeLong(x,y));
    if  SelectedField.DataType=ftString then
    begin
      SelectedField.Dataset.edit;
      SelectedField.AsString:=Edit1.text;
    end;
  end;
end;
//指针控制
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled:=false;
  with Dbgrid1.DataSource.DataSet do
  try
    if not checkbox1.Checked then  DisableControls;
    first;
    while not eof do
    begin
     sleep(50);
     application.ProcessMessages;
     button1.Caption:=inttostr(RecNo);
     next;
    end;
    first;
  finally
    if not checkbox1.Checked then EnableControls;
  end;
  Button1.Enabled:=True;
  button1.Caption:='Go';
end;

//定制下拉框
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
  for i:=0 to dbgrid1.Columns.Count-1 do
    if dbgrid1.Columns[i].FieldName=combobox1.Text then
    begin
      dbgrid1.Columns[1].PickList:=memo1.Lines;
      TDrawGrid(dbgrid1).col:=i;
      dbgrid1.SetFocus;
    end;
end;

 

{Excel}

//导出到excel
procedure Tform1.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 := self;
 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;

procedure TForm1.N4Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;


{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
设计：CoolSlob
日期：2002-10-23
支持：[e-mail]
调用格式：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; 

 

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   CopyDbDataToExcel([dbgrid1])
end;