frm_main.pas

非常不错的EXCEL格式导出数据

unit frm_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB,
  Excel2000, OleServer, Mask;

type
  TForm1 = class(TForm)
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    rbtoexcel: TGroupBox;
    DBNavigator1: TDBNavigator;
    edtleftheader: TEdit;
    edtcenterheader: TEdit;
    edtrightheader: TEdit;
    edtleftfooter: TEdit;
    edtcenterfooter: TEdit;
    edtrightfooter: TEdit;
    edtbeginx: TEdit;
    edtendx: TEdit;
    edtbeginy: TEdit;
    edtendy: TEdit;
    cbtitle: TCheckBox;
    Button1: TButton;
    btnmerge: TButton;
    btnfont: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    DBEdit1: TDBEdit;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    procedure Button1Click(Sender: TObject);
    procedure btnmergeClick(Sender: TObject);
    procedure btnfontClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses frm_control;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
begin
  with excelapplication1 do
  begin
    disconnect;//start
    visible[0]:=true;
    sheetsinnewworkbook[0]:=1;
    workbooks.Add(emptyparam,0);//empty file
    excelworkbook1.ConnectTo(workbooks[workbooks.count] as _workbook);//finish excelworkbook1 linked
  end;
  with excelworksheet1 do
  begin
    connectto(excelworkbook1.sheets[1] as _worksheet);
    name:='报表';
    with pagesetup do
    begin
      headermargin:=1;
      //header setup
      leftheader:=edtleftheader.text;
      centerheader:=edtcenterheader.text;
      rightheader:=edtrightheader.text;
      //footer setup
      leftfooter:=edtleftfooter.text;
      centerfooter:=edtcenterfooter.text;
      rightfooter:=edtrightfooter.text;
    end;
  end;
  j:=1;
  with adotable1 do
  begin
    if cbtitle.Checked then
    with excelworksheet1 do
    begin
      for i:=1 to fields.Count do
      begin
        cells.Item[1,i]:=fields[i-1].DisplayName;
        with range[cells.Item[1,1],cells.Item[1,fields.Count]] do
        begin
          interior.Color:=clgray;
          font.Bold:=1;
        end;
      end;
    inc(j);
    end;

    first;
    while not eof do
    begin
      for i:=1 to fields.count do
      begin
        excelworksheet1.Cells.Item[j,i]:=fields[i-1].value;
      end;
      next;
      inc(j);
    end;
  end;  
end;

procedure TForm1.btnmergeClick(Sender: TObject);
var
r: Range;
x0,y0,x1,y1:integer;
begin
  //definition
  x0:=strtoint(edtbeginx.Text);
  y0:=strtoint(edtbeginy.Text);
  x1:=strtoint(edtendx.Text);
  y1:=strtoint(edtendy.Text);
  //excute the order
  with excelapplication1 do
  begin
    r:=range[cells.item[x0,y0],cells.item[x1,y1]];
    r.merge(false);
  end;
end;

procedure TForm1.btnfontClick(Sender: TObject);
begin
   with tform2.Create(self,excelworksheet1) do
   begin
     try
       showmodal;
     finally
       free;
     end;
   end;
  {with fexcelsheet,fpoit do
  begin
    hpagebreaks.add(range[cells.item[x,y],cells.item[x,y]);
  end;

  with fexcelsheet,fpoit do
    if cbitaly.checked then
      range[cells.item[x,y],cells.item[x,y]].font.italic:=1
    else
      range[cells.item[x,y],cells.item[x,y]].font.italic:=1;
}
end;

end.