outtoexcelunit.pas

书籍类别（种类编号

unit OutToExcelUnit;

interface

uses
  Classes, windows, SysUtils;

type
  OutToExcel = class(TThread)
  SentMsg : String;   //传递进程信息
  I1      : Integer;  //总数
  I2      : Integer;  //进度数
  procedure postMessages;  //传递信息
  procedure QueryMessage;  //显示过程
  procedure DoOutData;      //导出数据 
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    constructor Create(Runing:Boolean);    
  end;

implementation

uses Progress;

{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure OutToExcel.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ OutToExcel }

constructor OutToExcel.Create(Runing: Boolean);
begin
  SentMsg:='正在准备将数据导出到Excel，请稍候…………';
  Synchronize(postMessages);
  ProgressForm.RzProgressBar1.Percent:=0;
inherited Create(Not Runing);
end;

procedure OutToExcel.DoOutData;
var
   exls,sheet    : variant;
   fieldNum,I,j  : integer;
   S,S2          : String;
begin
  try
    exls:=createoleobject('Excel.application');
    sheet:=createoleobject('excel.sheet');
  except
    Messagebox(handle,'未发现系统中安装了Microsoft Excel，在使用该功能前，请先将其安装！','错误',mb_ok+mb_iconwarning);
    Exit;
  end;
try
   sheet:=exls.workBooks.add;
   Exls.worksheets[1].range['A1:L1'].Merge(True);
   Exls.Cells[1,1].value:='我的通迅录';
   Exls.Cells[1,1].Font.Size:=30;
   ExLs.worksheets[1].Range['A1:L1'].Font.Name := '楷体_GB2312';
   //第一行高39
   Exls.worksheets[1].Rows[1].RowHeight := 39;
   with DM1.ADODataSet1 do try
     DisableControls;
     I1:=RecordCount;
     FieldNum:=FieldCount;
     for i:=1 to FieldNum-2 do begin
        Exls.Cells[2,i].value:=FieldDefList.Strings[i-1];
        Exls.Cells[2,i].Font.Size:=9;
     end;
     Exls.Cells[2,1].ColumnWidth:=10;
     Exls.Cells[2,2].ColumnWidth:=12;
     Exls.Cells[2,3].ColumnWidth:=10;
     Exls.Cells[2,4].ColumnWidth:=10;
     Exls.Cells[2,5].ColumnWidth:=10;
     Exls.Cells[2,6].ColumnWidth:=23;
     Exls.Cells[2,7].ColumnWidth:=10;
     Exls.Cells[2,8].ColumnWidth:=23;
     Exls.Cells[2,9].ColumnWidth:=23;
     Exls.Cells[2,10].ColumnWidth:=18;
     Exls.Cells[2,11].ColumnWidth:=8;
     Exls.Cells[2,12].ColumnWidth:=40;
     First;
     SentMsg:='正在将数据导出到Excel，请稍候…………';
     Synchronize(postMessages);
     i:=3;
     while not eof do begin
       I2:=I-2;
       Synchronize(QueryMessage);
       for j:=1 to fieldNum-2 do  begin
         exls.Cells[i,j]:=fields[j-1].AsString;
         exls.Cells[i,j].Font.Size:=9;      //设置字体为小五
       end;
     next;
     i:=i+1;
     end;
     EnableControls ;
    //为表格加入边框
    S:='A2:L'+IntToStr(RecordCount+2);
    S2:='A2:L'+IntToStr(RecordCount+2);
    Exls.worksheets[1].Range[S].Borders.LineStyle := 1;
    //设置文字垂直、水平居中
    ExlS.worksheets[1].range[S2].HorizontalAlignment := $FFFFEFF4;
    ExlS.worksheets[1].range[S2].VerticalAlignment := $FFFFEFF4;

     //加粗第1、2行文字
     Exls.Cells[1,1].Font.Bold:=true;
     Exls.worksheets[1].Rows[2].Font.bold:=true;
     //加入一行作者信息]
     S:='A'+IntToStr(RecordCount+4)+':L'+IntToStr(RecordCount+4);
     Exls.worksheets[1].range[S].Merge(True);
     Exls.Cells[(RecordCount+4),1].value:='“我的通迅录”，作者：李栋；E-Mail：[e-mail]';
     Exls.Cells[(RecordCount+4),1].Font.Size:=9;
     Exls.Cells[RecordCount+4,1].Font.Bold:=true;
     //显示Excel
     exls.visible:=true;
   except
     Messagebox(handle,'数据导出到Excel时，发生意外失败。请稍候再试！','错误',MB_OK+MB_ICONERROR);
     Exit;
   end;
except
   Messagebox(handle,'将数据导出到Excel失败！请稍候再试！','错误',mb_ok+mb_iconerror);
end;
end;

procedure OutToExcel.Execute;
begin
  { Place thread code here }
  try
     DoOutData;
  finally
     Progressform.Close;
  end;
end;

procedure OutToExcel.postMessages;
begin
ProgressForm.RzGroupBox1.Caption:=SentMSG;
end;

procedure OutToExcel.QueryMessage;
begin
progressForm.RzProgressBar1.Percent:=round(100*(i2/i1));
end;

end.