outtoexcelunit.pas

基于高速铁路周边电动势计算的关键

unit OutToExcelUnit;

interface

uses
  Classes, windows, SysUtils,Forms,ADODB,Dialogs,Variants,ActiveX;

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

implementation

uses Progress, Comobj,DrawInfor, GlobalVarDefs;

{ 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;
   ms: tmemorystream; //流文件，保护模板
   lie:string;

begin
   FieldNum:=9;//字段数量
  try
    Exls:=createoleobject('Excel.application');
    sheet:=createoleobject('Excel.sheet');
  except
    Messagebox(handle,'未发现系统中安装了Microsoft Excel，在使用该功能前，请先将其安装！','错误',mb_ok+mb_iconwarning);
    Exit;
  end;

      lie:=Convert(FieldNum+1);//转换
try
   sheet:=Exls.workBooks.add;
   Exls.worksheets[1].range['A1:'+lie+'1'].Merge(True);
   Exls.Cells[1,1].value:='电动势测量结果记录';
   Exls.Cells[1,1].Font.Size:=14;
   ExLs.worksheets[1].Range['A1:'+lie+'1'].Font.Name := '宋体';
   //ExLs.worksheets[1].range['A1:'+lie+'400'].HorizontalAlignment := $FFFFEFF4;
   //ExLs.worksheets[1].range['A1:'+lie+'400'].VerticalAlignment := $FFFFEFF4;
   //第一行高39
   Exls.worksheets[1].Rows[1].RowHeight := 39;

   with DrawInforForm do try
     I1:=rNew_Infor.Num;

     exls.Cells[2,1]:='序号';
     Exls.worksheets[1].Range['A3:'+lie+inttostr(I1+2)].NumberFormatLocal:='@' ;

     Exls.worksheets[1].columns[7].NumberFormatLocal:='0.00000000';

     for i:=1 to FieldNum do begin
        Exls.Cells[2,i+1].value:=DDSStr[i];
        Exls.Cells[2,1].Font.Size:=9;
        Exls.Cells[2,i+1].Font.Size:=9;
     end;
     Exls.Cells[2,1].ColumnWidth:=8;
     Exls.Cells[2,2].ColumnWidth:=10;
     Exls.Cells[2,3].ColumnWidth:=10;
     Exls.Cells[2,4].ColumnWidth:=10;
     Exls.Cells[2,5].ColumnWidth:=10;
     Exls.Cells[2,6].ColumnWidth:=15;
     Exls.Cells[2,7].ColumnWidth:=15;
     Exls.Cells[2,8].ColumnWidth:=15;
     Exls.Cells[2,9].ColumnWidth:=15;
     Exls.Cells[2,10].ColumnWidth:=15;

     SentMsg:='正在将数据导出到Excel，请稍候…………';
     Synchronize(postMessages);
     i:=3;
     for i:=3 to  rNew_Infor.Num+2 do begin
       I2:=I-2;
       Synchronize(QueryMessage);
       exls.Cells[i,2] :=rNew_Infor.StratX[i-3];
       exls.Cells[i,3] :=rNew_Infor.StratY[i-3];
       exls.Cells[i,4] :=rNew_Infor.EndX[i-3];
       exls.Cells[i,5] :=rNew_Infor.EndY[i-3];
       exls.Cells[i,6] :=rNew_Infor.Lengthl[i-3];

       exls.Cells[i,7] :=rNew_Infor.AveDDL[i-3];

       exls.Cells[i,8] :=rNew_Infor.Id[i-3];
       exls.Cells[i,9] :=rNew_Infor.GDB_Is[i-3];
       exls.Cells[i,10]:=rNew_Infor.DDS_E[i-3];
      
       for j:=1 to fieldNum do  begin
         exls.Cells[i,1].Value := i-2;
         exls.Cells[i,1].Font.Size:=9;
         exls.Cells[i,j+1].Font.Size:=9;      //设置字体为小五
       end;
       end;
    //为表格加入边框
    S:='A2:'+lie+IntToStr(rNew_Infor.Num+2);
    S2:='A2:'+lie+IntToStr(rNew_Infor.Num+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(rNew_Infor.Num+4)+':'+Lie+IntToStr(rNew_Infor.Num+4);
     Exls.worksheets[1].range[S].Merge(True);
      ////////////////////////////////////////////////////////
      try
      Exls.ActiveSheet.PageSetup.Orientation:=2;  //页面方向:横向
      Exls.ActiveSheet.PageSetup.PrintTitleRows:='$1:$2'; //表头为1-4行
   // Excelid.worksheets[1].Range['A2:M3'].HasArray ;
   // Excelid.ActiveSheet.PageSetup.PaperSize:=5;    //纸张大小
      Exls.ActiveSheet.PageSetup.CenterFooter := '第&P頁';
      Exls.ActiveSheet.PageSetup.TopMargin := 1/0.035;
      Exls.ActiveSheet.PageSetup.LeftMargin := 1.5/0.035;
      Exls.ActiveSheet.PageSetup.rightMargin := 1.5/0.035;
      Exls.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;//水平居中
     ////////////////////////////////////////////////////////
     Exls.Cells[(rNew_Infor.Num+4),1].Font.Size:=9;
     Exls.Cells[rNew_Infor.Num+4,1].Font.Bold:=true;
        except
          end;
//显示Excel
    try
    Exls.visible:=true;
    except
      end;



   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
     CoInitialize(nil);
     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;
function OutToExcel.Convert(intt:integer):string;
 var
lie: string;
begin
 case intt of
  2: lie:='B';
  3: lie:='C';
  4: lie:='D';
  5: lie:='E';
  6: lie:='F';
  7: lie:='G';
  8: lie:='H';
  9: lie:='I';
  10: lie:='J';
  11: lie:='K';
  12: lie:='L';
  13: lie:='M';
  14: lie:='N';
  15: lie:='O';
  16: lie:='P';
  17: lie:='Q';
  18: lie:='R';
  19: lie:='S';
  20: lie:='T';
  21: lie:='U';
  22: lie:='V';
  23: lie:='W';
  24: lie:='X';
  25: lie:='Y';
  26: lie:='Z';
  27: lie:='AA';
  28: lie:='AB';
  29: lie:='AC';
  30: lie:='AD';
 31: lie:='AE';
 32: lie:='AF';
 33: lie:='AG';
 34: lie:='AH';
 35: lie:='AI';
 36: lie:='AJ';
 37: lie:='AK';
 38: lie:='AL';
 49: lie:='AM';
 40: lie:='AN';
 41: lie:='AO';
 42: lie:='AP';
 43: lie:='AQ';
 44: lie:='AR';
 45: lie:='AS';
 46: lie:='AT';
 47: lie:='AU';
 48: lie:='AV';
  end;
 result:= lie;
end;

end.