DBGrid 应用全书[感谢archonwang] airii的blog上看到的文章,动了动手 原文http://www.delphibbs.com/keylife/iblog_show.asp?xid=4091原文非常完整。经整理,每项都在delphi7下测试过,可以到http://www.efile.com.cn/Home.asp?User=jin2004下载演示代码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: TBook; col, row: Integer; sline: String; mem: TMemo; ExcelApp: Variant; begin Screen.Cursor := crHourglass; DBGrid1.DataSource.DataSet.DisableControls; bm := DBGrid1.DataSource.DataSet.GetBook; 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.GotoBook(bm); DBGrid1.DataSource.DataSet.FreeBook(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 支持:[email protected] 调用格式: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;
如使dbgrid1中'序号'为'合计'的一行为淺黄色,用dbgrid的ondrawcolumncell事件,代码如下: procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var oldcolor:tcolor; oldpm:tpenmode; begin if table1.fieldbyname('序号').asString='合计' then {设定变色的行的条件} begin oldpm:= DBGrid1.Canvas.pen.mode; oldcolor:= dbGrid1.Canvas.Brush.color; dbGrid1.Canvas.Brush.color:=clinfobk; dbGrid1.Canvas.pen.mode:=pmmask; dbGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State); dbGrid1.Canvas.Brush.color:=oldcolor; dbGrid1.Canvas.pen.mode:=oldpm; end; end;
列:和下面代码类似,自己根据实际要求改改吧! procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Column.FieldName <> 'SIZE' then Exit; if Table1.FieldByName('SIZE').AsInteger>10 then begin DBGrid1.Canvas.Brush.Color:=clblue; //改变底色 DBGrid1.Canvas.Font.Color:=clred; //改变字体颜色 DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State); end; end;
airii的blog上看到的文章,动了动手
原文http://www.delphibbs.com/keylife/iblog_show.asp?xid=4091原文非常完整。经整理,每项都在delphi7下测试过,可以到http://www.efile.com.cn/Home.asp?User=jin2004下载演示代码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: TBook;
col, row: Integer;
sline: String;
mem: TMemo;
ExcelApp: Variant;
begin
Screen.Cursor := crHourglass;
DBGrid1.DataSource.DataSet.DisableControls;
bm := DBGrid1.DataSource.DataSet.GetBook;
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.GotoBook(bm);
DBGrid1.DataSource.DataSet.FreeBook(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
支持:[email protected]
调用格式: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;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
oldcolor:tcolor;
oldpm:tpenmode;
begin
if table1.fieldbyname('序号').asString='合计' then {设定变色的行的条件}
begin
oldpm:= DBGrid1.Canvas.pen.mode;
oldcolor:= dbGrid1.Canvas.Brush.color;
dbGrid1.Canvas.Brush.color:=clinfobk;
dbGrid1.Canvas.pen.mode:=pmmask;
dbGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
dbGrid1.Canvas.Brush.color:=oldcolor;
dbGrid1.Canvas.pen.mode:=oldpm;
end;
end;
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if Column.FieldName <> 'SIZE' then Exit;
if Table1.FieldByName('SIZE').AsInteger>10 then
begin
DBGrid1.Canvas.Brush.Color:=clblue; //改变底色
DBGrid1.Canvas.Font.Color:=clred; //改变字体颜色
DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
end;