{***********************************************************************}
{*在 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 ;