{***********************************************************************}
{*在 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
支持: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;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
CopyDbDataToExcel([dbgrid1])
end;
{*在 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
支持: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;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
CopyDbDataToExcel([dbgrid1])
end;