Delphi下一个封装较为完整的DBGrid->Excel类

unit DBGridEhToExcel; 

interface 
uses 
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
Dialogs, DB, ComCtrls, ExtCtrls, StdCtrls, Gauges, DBGridEh, ShellApi; 

type 
TTitleCell = array of array of String; 

//分解DBGridEh的标题 
TDBGridEhTitle = class 
private 
   FDBGridEh: TDBGridEh;  //对应DBGridEh 
   FColumnCount: integer; //DBGridEh列数(指visible为True的列数) 
   FRowCount: integer;    //DBGridEh多表头层数(没有多表头则层数为1) 
   procedure SetDBGridEh(const Value: TDBGridEh); 
   function GetTitleRow: integer;    //获取DBGridEh多表头层数 
   function GetTitleColumn: integer; //获取DBGridEh列数 
public 
   //分解DBGridEh标题，由TitleCell二维动态数组返回 
   procedure GetTitleData(var TitleCell: TTitleCell); 
published 
   property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh; 
   property ColumnCount: integer read FColumnCount; 
   property RowCount: integer read FRowCount; 
end; 

TDBGridEhToExcel = class(TComponent) 
private 
   FCol: integer; 
   FRow: integer; 
   FProgressForm: TForm;                                  {进度窗体} 
   FGauge: TGauge;                                        {进度条} 
   Stream: TStream;                                       {输出文件流} 
   FBookMark: TBookmark;                                   
   FShowProgress: Boolean;                                {是否显示进度窗体} 
   FDBGridEh: TDBGridEh; 
   FBeginDate: TCaption;                                  {开始日期} 
   FTitleName: TCaption;                                  {Excel文件标题} 
   FEndDate: TCaption;                                    {结束日期} 
   FUserName: TCaption;                                   {制表人} 
   FFileName: String;                                     {保存文件名} 
   procedure SetShowProgress(const Value: Boolean); 
   procedure SetDBGridEh(const Value: TDBGridEh); 
   procedure SetBeginDate(const Value: TCaption); 
   procedure SetEndDate(const Value: TCaption); 
   procedure SetTitleName(const Value: TCaption); 
   procedure SetUserName(const Value: TCaption); 
   procedure SetFileName(const Value: String);     

   procedure IncColRow; 
   procedure WriteBlankCell;                              {写空单元格} 
   {写数字单元格} 
   procedure WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True); 
   {写整型单元格} 
   procedure WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True); 
   {写字符单元格} 
   procedure WriteStringCell(const AValue: string; const IncStatus: Boolean=True); 
   procedure WritePrefix; 
   procedure WriteSuffix; 
   procedure WriteHeader;                                 {输出Excel标题} 
   procedure WriteTitle;                                  {输出Excel列标题} 
   procedure WriteDataCell;                               {输出数据集内容} 
   procedure WriteFooter;                                 {输出DBGridEh表脚} 
   procedure SaveStream(aStream: TStream); 
   procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体} 
   {根据表格修改数据集字段顺序及字段中文标题} 
   procedure SetDataSetCrossIndexDBGridEh; 
public 
   constructor Create(AOwner: TComponent); override; 
   destructor Destroy; override; 
   procedure ExportToExcel; {输出Excel文件} 
published 
   property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh; 
   property ShowProgress: Boolean read FShowProgress write SetShowProgress; 
   property TitleName: TCaption read FTitleName write SetTitleName; 
   property BeginDate: TCaption read FBeginDate write SetBeginDate; 
   property EndDate: TCaption read FEndDate write SetEndDate; 
   property UserName: TCaption read FUserName write SetUserName; 
   property FileName: String read FFileName write SetFileName; 
end; 

var 
CXlsBof: array[0..5] of Word = (9, 8, 0, , 0, 0); 
CXlsEof: array[0..1] of Word = ({post.content}A, 00); 
CXlsLabel: array[0..5] of Word = (4, 0, 0, 0, 0, 0); 
CXlsNumber: array[0..4] of Word = (3, 14, 0, 0, 0); 
CXlsRk: array[0..4] of Word = (E, 10, 0, 0, 0); 
CXlsBlank: array[0..4] of Word = (1, 6, 0, 0, ); 

implementation 
{ TDBGridEhTitle } 


function TDBGridEhTitle.GetTitleColumn: integer; 
var 
i, ColumnCount: integer; 
begin 
ColumnCount := 0; 
for i := 0 to DBGridEh.Columns.Count - 1 do 
begin 
   if DBGridEh.Columns[i].Visible then 
     Inc(ColumnCount); 
end; 

Result := ColumnCount; 
end; 

procedure TDBGridEhTitle.GetTitleData(var TitleCell: TTitleCell); 
var 
i, Row, Col: integer; 
Caption: String; 
begin 
FColumnCount := GetTitleColumn; 
FRowCount := GetTitleRow; 
SetLength(TitleCell,FColumnCount,FRowCount); 
Row := 0; 
for i := 0 to DBGridEh.Columns.Count - 1 do 
begin 
   if DBGridEh.Columns[i].Visible then 
   begin 
     Col := 0; 
     Caption := DBGridEh.Columns[i].Title.Caption; 
     while POS('|', Caption) > 0 do 
     begin 
       TitleCell[Row,Col] := Copy(Caption, 1, Pos('|',Caption)-1); 
       Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption)); 
       Inc(Col); 
     end; 
     TitleCell[Row, Col] := Caption; 
     Inc(Row); 
   end; 
end; 
end; 

function TDBGridEhTitle.GetTitleRow: integer; 
var 
i, j: integer; 
MaxRow, Row: integer; 
begin 
MaxRow := 1; 
for i := 0 to DBGridEh.Columns.Count - 1 do 
begin 
   Row := 1; 
   for j := 0 to Length(DBGridEh.Columns[i].Title.Caption) do 
   begin 
     if DBGridEh.Columns[i].Title.Caption[j] = '|' then 
       Inc(Row); 
   end; 

   if MaxRow < Row then 
     MaxRow :=  Row; 
end; 

Result := MaxRow; 
end; 

procedure TDBGridEhTitle.SetDBGridEh(const Value: TDBGridEh); 
begin 
FDBGridEh := Value; 
end; 

{ TDBGridEhToExcel } 

constructor TDBGridEhToExcel.Create(AOwner: TComponent); 
begin 
inherited Create(AOwner); 
FShowProgress := True; 
end; 

procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean); 
begin 
FShowProgress := Value; 
end; 

procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh); 
begin 
FDBGridEh := Value; 
end; 

procedure TDBGridEhToExcel.SetBeginDate(const Value: TCaption); 
begin 
FBeginDate := Value; 
end; 

procedure TDBGridEhToExcel.SetEndDate(const Value: TCaption); 
begin 
FEndDate := Value; 
end; 

procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption); 
begin 
FTitleName := Value; 
end; 

procedure TDBGridEhToExcel.SetUserName(const Value: TCaption); 
begin 
FUserName := Value; 
end; 

procedure TDBGridEhToExcel.SetFileName(const Value: String); 
begin 
FFileName := Value; 
end; 

procedure TDBGridEhToExcel.IncColRow; 
begin 
if FCol = DBGridEh.DataSource.DataSet.FieldCount - 1 then 
begin 
   Inc(FRow); 
   FCol := 0; 
end 
else 
   Inc(FCol); 
end; 

procedure TDBGridEhToExcel.WriteBlankCell; 
begin 
CXlsBlank[2] := FRow; 
CXlsBlank[3] := FCol; 
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank)); 
IncColRow; 
end; 

procedure TDBGridEhToExcel.WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True); 
begin 
CXlsNumber[2] := FRow; 
CXlsNumber[3] := FCol; 
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber)); 
Stream.WriteBuffer(AValue, 8); 

if IncStatus then 
   IncColRow; 
end; 

procedure TDBGridEhToExcel.WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True); 
var 
V: Integer; 
begin 
CXlsRk[2] := FRow; 
CXlsRk[3] := FCol; 
Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk)); 
V := (AValue Shl 2) Or 2; 
Stream.WriteBuffer(V, 4); 

if IncStatus then 
   IncColRow; 
end; 

procedure TDBGridEhToExcel.WriteStringCell(const AValue: string; const IncStatus: Boolean=True); 
var 
L: integer; 
begin 
L := Length(AValue); 
CXlsLabel[1] := 8 + L; 
CXlsLabel[2] := FRow; 
CXlsLabel[3] := FCol; 
CXlsLabel[5] := L; 
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 
Stream.WriteBuffer(Pointer(AValue)^, L); 

if IncStatus then 
   IncColRow; 
end; 

procedure TDBGridEhToExcel.WritePrefix; 
begin 
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof)); 
end; 

procedure TDBGridEhToExcel.WriteSuffix; 
begin 
Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof)); 
end; 

procedure TDBGridEhToExcel.WriteHeader; 
var 
OpName, OpDate: String; 
begin 
//标题 
FCol := 3; 
WriteStringCell(TitleName,False); 
FCol := 0; 

Inc(FRow); 

if Trim(BeginDate) <> '' then 
begin 
   //开始日期 
   FCol := 0; 
   WriteStringCell(BeginDate,False); 
   FCol := 0 
end; 

if Trim(EndDate) <> '' then 
begin 
   //结束日期 
   FCol := 5; 
   WriteStringCell(EndDate,False); 
   FCol := 0; 
end; 

if (Trim(BeginDate) <> '') or (Trim(EndDate) <> '') then 
   Inc(FRow); 

//制表人 
OpName := '制表人：' + UserName; 
FCol := 0; 
WriteStringCell(OpName,False); 
FCol := 0; 

//制表时间 
OpDate := '制表时间：' + DateTimeToStr(Now); 
FCol := 5; 
WriteStringCell(OpDate,False); 
FCol := 0; 

Inc(FRow);   
end; 

procedure TDBGridEhToExcel.WriteTitle; 
var 
i, j: integer; 
DBGridEhTitle: TDBGridEhTitle; 
TitleCell: TTitleCell; 
begin 
DBGridEhTitle := TDBGridEhTitle.Create; 
try 
   DBGridEhTitle.DBGridEh := FDBGridEh; 
   DBGridEhTitle.GetTitleData(TitleCell); 

   try 
     for i := 0 to DBGridEhTitle.RowCount - 1 do 
     begin 
       for j := 0 to DBGridEhTitle.ColumnCount - 1 do 
       begin 
         FCol := j; 
         WriteStringCell(TitleCell[j,i],False); 
       end; 
       Inc(FRow); 
     end; 
     FCol := 0; 
   except 

   end; 
finally 
   DBGridEhTitle.Free; 
end; 
end; 


procedure TDBGridEhToExcel.WriteDataCell; 
var 
i: integer; 
begin 
DBGridEh.DataSource.DataSet.DisableControls; 
FBookMark := DBGridEh.DataSource.DataSet.GetBookmark; 
try 
   DBGridEh.DataSource.DataSet.First; 
   while not DBGridEh.DataSource.DataSet.Eof do 
   begin 
     for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do 
     begin 
       if DBGridEh.DataSource.DataSet.Fields[i].IsNull or (not DBGridEh.DataSource.DataSet.Fields[i].Visible) then 
         WriteBlankCell 
       else 
       begin 
         case DBGridEh.DataSource.DataSet.Fields[i].DataType of 
           ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes: 
             WriteIntegerCell(DBGridEh.DataSource.DataSet.Fields[i].AsInteger); 
           ftFloat, ftCurrency, ftBCD: 
             WriteFloatCell(DBGridEh.DataSource.DataSet.Fields[i].AsFloat); 
         else 
           if DBGridEh.DataSource.DataSet.Fields[i] Is TBlobfield then  // 此类型的字段(图像等)暂无法读取显示 
             WriteStringCell('') 
           else 
             WriteStringCell(DBGridEh.DataSource.DataSet.Fields[i].AsString); 
         end; 
       end; 
     end; 

     //显示进度条进度过程 
     if ShowProgress then 
     begin 
       FGauge.Progress := DBGridEh.DataSource.DataSet.RecNo; 
       FGauge.Refresh; 
     end; 

     DBGridEh.DataSource.DataSet.Next; 
   end; 

finally 
   if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then 
   DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark); 

   DBGridEh.DataSource.DataSet.EnableControls; 
end; 
end; 

procedure TDBGridEhToExcel.WriteFooter; 
var 
i, j: integer; 
begin 
if DBGridEh.FooterRowCount = 0 then exit; 

FCol := 0; 
if DBGridEh.FooterRowCount = 1 then 
begin 
   for i := 0 to DBGridEh.Columns.Count - 1 do 
   begin 
     if DBGridEh.Columns[i].Visible then 
     begin 
       WriteStringCell(DBGridEh.Columns[i].Footer.Value,False); 
       Inc(FCol); 
     end; 
   end; 
end 
else if DBGridEh.FooterRowCount > 1 then 
begin 
   for i := 0 to DBGridEh.Columns.Count - 1 do 
   begin 
     if DBGridEh.Columns[i].Visible then 
     begin 
       for j := 0 to DBGridEh.Columns[i].Footers.Count - 1 do 
       begin 
         WriteStringCell(DBGridEh.Columns[i].Footers[j].Value ,False); 
         Inc(FRow); 
       end; 
       Inc(FCol); 
       FRow := FRow - DBGridEh.Columns[i].Footers.Count; 
     end; 
   end; 
end; 
FCol := 0; 
end; 

procedure TDBGridEhToExcel.SaveStream(aStream: TStream); 
begin 
FCol := 0; 
FRow := 0; 
Stream := aStream; 

//输出前缀 
WritePrefix; 

//输出表格标题 
WriteHeader; 

//输出列标题 
WriteTitle; 

//输出数据集内容 
WriteDataCell; 

//输出DBGridEh表脚 
WriteFooter; 

//输出后缀 
WriteSuffix; 
end; 

procedure TDBGridEhToExcel.ExportToExcel; 
var 
FileStream: TFileStream; 
Msg: String; 
begin 
//如果数据集为空或没有打开则退出 
if (DBGridEh.DataSource.DataSet.IsEmpty) or (not DBGridEh.DataSource.DataSet.Active) then 
   exit; 

//如果保存的文件名为空则退出 
if Trim(FileName) = '' then 
   exit; 
    
//根据表格修改数据集字段顺序及字段中文标题 
SetDataSetCrossIndexDBGridEh; 

Screen.Cursor := crHourGlass; 
try 
   try 
     if FileExists(FileName) then 
     begin 
       Msg := '已存在文件（' + FileName + '），是否覆盖？'; 
       if Application.MessageBox(PChar(Msg),'提示',MB_YESNO+MB_ICONQUESTION+MB_DEFBUTTON2) = IDYES then 
       begin 
         //删除文件 
         DeleteFile(FileName) 
       end 
       else 
         exit; 
     end; 

     //显示进度窗体 
     if ShowProgress then 
       CreateProcessForm(nil); 
        
     FileStream := TFileStream.Create(FileName, fmCreate); 
     try 
       //输出文件 
       SaveStream(FileStream); 
     finally 
       FileStream.Free; 
     end; 
      
     //打开Excel文件 
     ShellExecute(0, 'Open', PChar(FileName), nil, nil, SW_SHOW); 
   except 

   end; 
finally 
   if ShowProgress then 
     FreeAndNil(FProgressForm); 
   Screen.Cursor := crDefault; 
end; 
end; 

destructor TDBGridEhToExcel.Destroy; 
begin 
inherited Destroy; 
end; 

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent); 
var 
Panel: TPanel; 
Prompt: TLabel;                                           {提示的标签} 
begin 
if Assigned(FProgressForm) then 
   exit; 

FProgressForm := TForm.Create(AOwner); 
with FProgressForm do 
begin 
   try 
     Font.Name := '宋体';                                  {设置字体} 
     Font.Size := 9; 
     BorderStyle := bsNone; 
     Width := 300; 
     Height := 100; 
     BorderWidth := 1; 
     Color := clBlack; 
     Position := poScreenCenter; 

     Panel := TPanel.Create(FProgressForm); 
     with Panel do 
     begin 
       Parent := FProgressForm; 
       Align := alClient; 
       BevelInner := bvNone; 
       BevelOuter := bvRaised; 
       Caption := ''; 
     end; 

     Prompt := TLabel.Create(Panel); 
     with Prompt do 
     begin 
       Parent := Panel; 
       AutoSize := True; 
       Left := 25; 
       Top := 25; 
       Caption := '正在导出数据，请稍候......'; 
       Font.Style := [fsBold]; 
     end; 

     FGauge := TGauge.Create(Panel); 
     with FGauge do 
     begin 
       Parent := Panel; 
       ForeColor := clBlue; 
       Left := 20; 
       Top := 50; 
       Height := 13; 
       Width := 260; 
       MinValue := 0; 
       MaxValue := DBGridEh.DataSource.DataSet.RecordCount; 
     end; 
   except 

   end; 
end; 

FProgressForm.Show; 
FProgressForm.Update; 
end; 

procedure TDBGridEhToExcel.SetDataSetCrossIndexDBGridEh; 
var 
i: integer; 
begin 
for i := 0 to DBGridEh.Columns.Count - 1 do 
begin 
   DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Index := i; 
   DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).DisplayLabel 
     := DBGridEh.Columns.Items[i].Title.Caption; 
   DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Visible := 
     DBGridEh.Columns.Items[i].Visible; 
end; 

for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do 
begin 
   if POS('*****',DBGridEh.DataSource.DataSet.Fields[i].DisplayLabel) > 0 then 
     DBGridEh.DataSource.DataSet.Fields[i].Visible := False; 
end;   
end; 

end. 


/*****************************************************************/ 

调用的例子 

var 
DBGridEhToExcel: TDBGridEhToExcel; 
begin 
DBGridEhToExcel := TDBGridEhToExcel.Create(nil); 
try 
   DBGridEhToExcel.TitleName := '测试测试测试测试测试测试测试'; 
   DBGridEhToExcel.BeginDate := '开始日期：2005-07-01'; 
   DBGridEhToExcel.EndDate := '结束日期：2005-07-18'; 
   DBGridEhToExcel.UserName := '系统管理员'; 
   DBGridEhToExcel.DBGridEh := DBGridEh1; 
   DBGridEhToExcel.ShowProgress := True; 
   DBGridEhToExcel.FileName := 'c:3.xls'; 
   DBGridEhToExcel.ExportToExcel; 
finally 
   DBGridEhToExcel.Free; 
end; 
end;