unit_frm_rszltoexcel.pas

Excel导入导出:This TscExcelExport component is an advanced, powerfull but easy component to export all r

unit Unit_frm_rszlToExcel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, scExcelExport, ExtCtrls, RzPanel, RzStatus, StdCtrls, RzLabel,
  RzButton, DB, ADODB, RzPrgres, Gauges, DateUtils;

type
  TForm_rszlToExcel = class(TForm)
    ExcelEpt1: TscExcelExport;
    dlgSave1: TSaveDialog;
    rzsb1: TRzStatusBar;
    rzgsts1: TRzGlyphStatus;
    rzsp1: TRzStatusPane;
    rzgrp1: TRzGroupBox;
    lbl1: TRzLabel;
    lbl2: TRzLabel;
    rzgrp2: TRzGroupBox;
    rzbbtn_excel: TRzBitBtn;
    rzbbtn_close: TRzBitBtn;
    qry1: TADOQuery;
    rzpnl1: TRzPanel;
    gg1: TGauge;
    rzbbtn_closeapp: TRzBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure rzbbtn_closeappClick(Sender: TObject);
    procedure rzbbtn_closeClick(Sender: TObject);
    procedure rzbbtn_excelClick(Sender: TObject);
    procedure ExcelEpt1ExportRecords(Sender: TObject;
      IntRecordNumber: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form_rszlToExcel: TForm_rszlToExcel;

implementation
uses
  Unit_dm1;
{$R *.dfm}

function GetDateTimeStr(DateTimeSource:TDateTime): string;
var
  s: string;
begin
  s := IntToStr(YearOf(DateTimeSource));
  if MonthOf(DateTimeSource)<10 then
  begin
    s := s+'0';
  end;
  s := s+IntToStr(MonthOf(DateTimeSource));
  if DayOf(DateTimeSource)<10 then
  begin
    s := s+'0';
  end;
  s := s+IntToStr(DayOf(DateTimeSource));
  if HourOf(DateTimeSource)<10 then
  begin
    s := s+'0';
  end;
  s := s+IntToStr(HourOf(DateTimeSource));
  if MinuteOf(DateTimeSource)<10 then
  begin
    s := s+'0';
  end;
  s := s+IntToStr(MinuteOf(DateTimeSource)); 
  if SecondOf(DateTimeSource)<10 then
  begin
    s := s+'0';
  end;
  s := s+IntToStr(SecondOf(DateTimeSource));
  Result := s;
end;

procedure TForm_rszlToExcel.FormCreate(Sender: TObject);
begin
  rzsb1.Height := 22;
end;

procedure TForm_rszlToExcel.FormShow(Sender: TObject);
var
  ver: string;
begin
  case ExcelEpt1.ExcelVersion of
    8:
      ver := 'Microsoft Office Excel 97';
    9:
      ver := 'Microsoft Office Excel 2000';
    10:
      ver := 'Microsoft Office Excel XP';
    11:
      ver := 'Microsoft Office Excel 2003';
  end;
  lbl1.Caption := '当前 Excel 版本是：'+ver;
end;

procedure TForm_rszlToExcel.rzbbtn_closeappClick(Sender: TObject);
begin
  ExcelEpt1.CloseAllExcelApps;
end;

procedure TForm_rszlToExcel.rzbbtn_closeClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_rszlToExcel.rzbbtn_excelClick(Sender: TObject);
var
  Duration : TDateTime;
begin
  with qry1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT 工号 AS [@@工号],姓名,部门编号 FROM 人事资料');
    SQL.Add('ORDER BY 工号,部门编号,姓名');
    Open;
    if not IsEmpty then
    begin
      dlgSave1.FileName := '人事资料'+GetDateTimeStr(Now);
      if dlgSave1.Execute then
      begin
        try
          gg1.MaxValue := qry1.RecordCount;
          gg1.MinValue := 0;
          gg1.Progress := 0;
          ExcelEpt1.LoadDefaultProperties;
          ExcelEpt1.ExcelVisible:=True;
          ExcelEpt1.WorksheetName := '人事资料';
          ExcelEpt1.Dataset:=qry1;
          ExcelEpt1.ExportDataset;
          ExcelEpt1.SaveAs(dlgSave1.FileName,ffXLS);
        finally
          ExcelEpt1.Disconnect;
        end; 
      end;
    end;
  end;
end;

procedure TForm_rszlToExcel.ExcelEpt1ExportRecords(Sender: TObject;
  IntRecordNumber: Integer);
begin
  rzsp1.Caption := ' 记录：'+IntToStr(IntRecordNumber);
  gg1.Progress := gg1.Progress+1;
end;

procedure TForm_rszlToExcel.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if qry1.Active then
    qry1.Close;
end;

end.