一个导出excel非常快的类_delphi教程:站长天空｜虚拟主机资讯|虚拟主机新闻|虚拟主机动态

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 = ($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;