一個(gè)導(dǎo)出Excel非常快的類(lèi)

2019-11-18 17:57:41

字體：大中小

供稿：網(wǎng)友

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的標(biāo)題
TDBGridEhTitle = class
PRivate
    FDBGridEh: TDBGridEh; //對(duì)應(yīng)DBGridEh
    FColumnCount: integer; //DBGridEh列數(shù)(指visible為T(mén)rue的列數(shù))
    FRowCount: integer;    //DBGridEh多表頭層數(shù)(沒(méi)有多表頭則層數(shù)為1)
    procedure SetDBGridEh(const Value: TDBGridEh);
    function GetTitleRow: integer;    //獲取DBGridEh多表頭層數(shù)
    function GetTitleColumn: integer; //獲取DBGridEh列數(shù)
public
    //分解DBGridEh標(biāo)題，由TitleCell二維動(dòng)態(tài)數(shù)組返回
    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;                                  {進(jìn)度窗體}
    FGauge: TGauge;                                        {進(jìn)度條}
    Stream: TStream;                                       {輸出文件流}
    FBookMark: TBookmark;
    FShowProgress: Boolean;                                {是否顯示進(jìn)度窗體}
    FDBGridEh: TDBGridEh;
    FBeginDate: TCaption;                                  {開(kāi)始日期}
    FTitleName: TCaption;                                  {Excel文件標(biāo)題}
    FEndDate: TCaption;                                    {結(jié)束日期}
    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;                              {寫(xiě)空單元格}
    {寫(xiě)數(shù)字單元格}
    procedure WriteFloatCell(const AValue: Double; const IncStatus: Boolean=True);
    {寫(xiě)整型單元格}
    procedure WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean=True);
    {寫(xiě)字符單元格}
    procedure WriteStringCell(const AValue: string; const IncStatus: Boolean=True);
    procedure WritePrefix;
    procedure WriteSuffix;
    procedure WriteHeader;                                 {輸出Excel標(biāo)題}
    procedure WriteTitle;                                  {輸出Excel列標(biāo)題}
    procedure WriteDataCell;                               {輸出數(shù)據(jù)集內(nèi)容}
    procedure WriteFooter;                                 {輸出DBGridEh表腳}
    procedure SaveStream(aStream: TStream);
    procedure CreateProcessForm(AOwner: TComponent);       {生成進(jìn)度窗體}
    {根據(jù)表格修改數(shù)據(jù)集字段順序及字段中文標(biāo)題}
    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
//標(biāo)題
FCol := 3;
WriteStringCell(TitleName,False);
FCol := 0;

Inc(FRow);

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

if Trim(EndDate) <> '' then
begin
    //結(jié)束日期
    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;

//制表時(shí)間
OpDate := '制表時(shí)間：' + 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 // 此類(lèi)型的字段(圖像等)暫無(wú)法讀取顯示
              WriteStringCell('')
            else
              WriteStringCell(DBGridEh.DataSource.DataSet.Fields[i].AsString);
          end;
        end;
      end;

      //顯示進(jìn)度條進(jìn)度過(guò)程
      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;

//輸出表格標(biāo)題
WriteHeader;

//輸出列標(biāo)題
WriteTitle;

//輸出數(shù)據(jù)集內(nèi)容
WriteDataCell;

//輸出DBGridEh表腳
WriteFooter;

//輸出后綴
WriteSuffix;
end;

procedure TDBGridEhToExcel.ExportToExcel;
var
FileStream: TFileStream;
Msg: String;
begin
//如果數(shù)據(jù)集為空或沒(méi)有打開(kāi)則退出
if (DBGridEh.DataSource.DataSet.IsEmpty) or (not DBGridEh.DataSource.DataSet.Active) then
exit;

//如果保存的文件名為空則退出
if Trim(FileName) = '' then
exit;

//根據(jù)表格修改數(shù)據(jù)集字段順序及字段中文標(biāo)題
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;

      //顯示進(jìn)度窗體
      if ShowProgress then
        CreateProcessForm(nil);

      FileStream := TFileStream.Create(FileName, fmCreate);
      try
        //輸出文件
        SaveStream(FileStream);
      finally
        FileStream.Free;
      end;

      //打開(kāi)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; {提示的標(biāo)簽}
begin
if Assigned(FProgressForm) then
exit;

FProgressForm := TForm.Create(AOwner);
with FProgressForm do
begin
    try
      Font.Name := '宋體';                                  {設(shè)置字體}
      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 := '正在導(dǎo)出數(shù)據(jù)，請(qǐng)稍候......';
        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.

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

調(diào)用的例子

var
DBGridEhToExcel: TDBGridEhToExcel;
begin
DBGridEhToExcel := TDBGridEhToExcel.Create(nil);
try
    DBGridEhToExcel.TitleName := '測(cè)試測(cè)試測(cè)試測(cè)試測(cè)試測(cè)試測(cè)試';
    DBGridEhToExcel.BeginDate := '開(kāi)始日期：2005-07-01';
    DBGridEhToExcel.EndDate := '結(jié)束日期：2005-07-18';
    DBGridEhToExcel.UserName := '系統(tǒng)管理員';
    DBGridEhToExcel.DBGridEh := DBGridEh1;
    DBGridEhToExcel.ShowProgress := True;
    DBGridEhToExcel.FileName := 'c:/123.xls';
    DBGridEhToExcel.ExportToExcel;
finally
    DBGridEhToExcel.Free;
end;