zoukankan      html  css  js  c++  java
  • 一个导出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 = ($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;


  • 相关阅读:
    Binary Tree Inorder Traversal
    Populating Next Right Pointers in Each Node
    Minimum Depth of Binary Tree
    Majority Element
    Excel Sheet Column Number
    Reverse Bits
    Happy Number
    House Robber
    Remove Linked List Elements
    Contains Duplicate
  • 原文地址:https://www.cnblogs.com/chance/p/342874.html
Copyright © 2011-2022 走看看