delphi 数据导出 进度条自己生成

unit U_func;

interface
 uses forms,SysUtils,ComCtrls,DBGrids,DB,Dialogs,Messages,Windows,ComObj,Controls,ADODB,StdCtrls,Graphics;

function  ProgressBarform(max:integer):tProgressBar;
function ExportToExcel(dbgrid:tdbgrid):boolean;
function queryExportToExcel(queryexport:tadoquery):boolean;

implementation

//生成一个显示进度条的窗体
function  ProgressBarform(max:integer):tProgressBar;
   var
       ProgressBar1:TProgressBar;
       form:tform;
   begin
       application.CreateForm(tform,form);
       form.Position:=poScreenCenter;
       form.BorderStyle:=bsnone;
       form.Height:=30;
       form.Width:=260;
       ProgressBar1:=TProgressBar.Create(form);
       ProgressBar1.Visible:=true;
       ProgressBar1.Smooth:=true;
       ProgressBar1.Max:=max;
       ProgressBar1.ParentWindow:=form.Handle;
       ProgressBar1.Height:=20;
       ProgressBar1.Width:=250;
       ProgressBar1.Left:=form.Left+5;
       ProgressBar1.Top:=form.Top+5;
       ProgressBar1.Step:=1;
       form.show;
       result:=ProgressBar1;
   end;

//将DBGRID中的内容导入到EXCEL中
function ExportToExcel(dbgrid:tdbgrid):boolean;
   const
       xlNormal=-4143;
   var
       i,j,k:integer;
       str,filename:string;
       excel:OleVariant;
       SavePlace:    TBookmark;
       savedialog:tsavedialog;
       ProgressBar1:TProgressBar;
   begin
       result:=false;
       filename:='';
       if   dbgrid.DataSource.DataSet.RecordCount>65536    then
             begin  
                 if application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno    then
                    exit;
             end;  
       screen.Cursor:=crHourGlass;
       try  
           excel:=CreateOleObject('Excel.Application');
           excel.workbooks.add;  
       except
           screen.cursor:=crDefault;
           showmessage('无法调用Excel！');  
           exit;  
       end;  
       savedialog:=tsavedialog.Create(nil);  
       savedialog.Filter:='Excel文件(*.xls)|*.xls';  
       if    savedialog.Execute    then
             begin
                 if    FileExists(savedialog.FileName)    then  
                       try  
                           if    application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes    then  
                                 DeleteFile(PChar(savedialog.FileName))
                           else  
                                 begin
                                     Excel.Quit;
                                     savedialog.free;
                                     screen.cursor:=crDefault;
                                     Exit;
                                 end;  
                       except
                           Excel.Quit;
                           savedialog.free;
                             screen.cursor:=crDefault;
                           Exit;  
                       end;
                 filename:=savedialog.FileName;  
             end;
       savedialog.free;
       application.ProcessMessages;  
       if    filename=''    then  
             begin  
                 result:=false;
                 Excel.Quit;  
                 screen.cursor:=crDefault;
                 exit;  
             end;  
       k:=0;  
       for    i:=0    to    dbgrid.Columns.count-1    do  
           begin  
               if    dbgrid.Columns.Items[i].Visible    then  
                     begin  
                         //Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;  
                         excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;
                         inc(k);  
                     end;  
           end;  
   
       dbgrid.DataSource.DataSet.DisableControls;  
       saveplace:=dbgrid.DataSource.DataSet.GetBookmark;  
       dbgrid.DataSource.dataset.First;  
       i:=2;  
       if    dbgrid.DataSource.DataSet.recordcount>65536    then
             ProgressBar1:=ProgressBarform(65536)
       else  
             ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);  
       while    not    dbgrid.DataSource.dataset.Eof    do  
           begin  
               k:=0;  
               for    j:=0    to    dbgrid.Columns.count-1    do  
                   begin  
                       if    dbgrid.Columns.Items[j].Visible    then
                             begin  
                                 excel.cells[i,k+1].NumberFormat:='@';  
                                 if    not    dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull    then  
                                       begin  
                                           str := dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;
                                           Excel.Cells[i, k + 1] := Str;
                                       end;  
                                 inc(k);  
                             end
                       else
                             continue;
                   end;  
               if    i=65536    then  
                     break;  
               inc(i);  
               ProgressBar1.StepBy(1);
               dbgrid.DataSource.dataset.next;
           end;
       progressbar1.Owner.Free;
       application.ProcessMessages;
       dbgrid.DataSource.dataset.GotoBookmark(SavePlace);
       dbgrid.DataSource.dataset.EnableControls;
   
       try
           if    copy(FileName,length(FileName)-3,4)<>'.xls'    then
                 FileName:=FileName+'.xls';
           Excel.ActiveWorkbook.SaveAs(FileName,xlNormal,'', '',False,False);
       except
           Excel.Quit;
             screen.cursor:=crDefault;
           exit;
       end;
       //Excel.Visible    :=    true;
       Excel.Quit;
       screen.cursor:=crDefault;
       Result:= true;
   end;
  
//将ADOQUERY的数据集导入到EXCEL中
function queryExportToExcel(queryexport:tadoquery):boolean;
   const
       xlNormal=-4143;
   var
       i,j,k:integer;
       str,filename:string;
       excel:OleVariant;
       savedialog:tsavedialog;
       ProgressBar1:TProgressBar;
   begin
       result:=false;
       filename:='';
       if   queryexport.RecordCount>65536    then
             begin  
                 if    application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno    then
                       exit;  
             end;  
       screen.Cursor:=crHourGlass;
       try  
           excel:=CreateOleObject('Excel.Application');
           excel.workbooks.add;  
       except  
             screen.cursor:=crDefault;  
           showmessage('无法调用Excel！');  
           exit;  
       end;  
       savedialog:=tsavedialog.Create(nil);  
       savedialog.Filter:='Excel文件(*.xls)|*.xls';  
       if    savedialog.Execute    then
             begin
                 if    FileExists(savedialog.FileName)    then  
                       try  
                           if    application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes    then
                                 DeleteFile(PChar(savedialog.FileName))
                           else  
                                 begin
                                     Excel.Quit;
                                     savedialog.free;
                                     screen.cursor:=crDefault;
                                     Exit;
                                 end;
                       except
                           Excel.Quit;
                           savedialog.free;
                             screen.cursor:=crDefault;
                           Exit;  
                       end;
                 filename:=savedialog.FileName;  
             end;
       savedialog.free;
       application.ProcessMessages;  
       if filename='' then
          begin
             result:=false;
             Excel.Quit;
             screen.cursor:=crDefault;
             exit;
          end;  
       k:=0;  
       for i:=0 to queryexport.FieldCount-1    do
           begin
            excel.cells[1,k+1]:=queryexport.Fields[i].FieldName;
            inc(k);
           end;
       queryexport.First;
       i:=2;  
       if    queryexport.recordcount>65536    then
             ProgressBar1:=ProgressBarform(65536)
       else  
             ProgressBar1:=ProgressBarform(queryexport.recordcount);
       while    not    queryexport.Eof    do
           begin
               k:=0;  
               for j:=0 to queryexport.FieldCount-1    do
                   begin  
                      excel.cells[i,k+1].NumberFormat:='@';
                      if not queryexport.fieldbyname(queryexport.Fields[j].FieldName).isnull    then
                         begin
                            str:=queryexport.fieldbyname(queryexport.Fields[j].FieldName).AsString;
                            Excel.Cells[i,    k    +    1]    :=    Str;
                         end;
                   inc(k);
                   end;
               if i=65536 then
                  break;
               inc(i);  
               ProgressBar1.StepBy(1);  
               queryexport.next;  
           end;
       progressbar1.Owner.Free;
       application.ProcessMessages;
       try
           if copy(FileName,length(FileName)-3,4)<>'.xls' then
              FileName:=FileName+'.xls';
           Excel.ActiveWorkbook.SaveAs(FileName,xlNormal,'', '',False,False);
       except
           Excel.Quit;
             screen.cursor:=crDefault;
           exit;
       end;
       //Excel.Visible    :=    true;
       Excel.Quit;
       screen.cursor:=crDefault;
       Result :=  true;
   end;

end.