[Delphi]一个导出 Excel 非常快的类
    [Delphi]一个导出 Excel 非常快的类    Q：[Delphi]一个导出 Excel 非常快的类 A：unit DBGridEhToExcel;interfaceuses 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 = ($809, 8, 0, $10, 0, 0); CXlsEof: array[0..1] of Word = ($0A, 00); CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0); CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0); CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0); CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);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:\123.xls’; DBGridEhToExcel.ExportToExcel; finally DBGridEhToExcel.Free; end;