reportbase.pas

产品信息系统!关于产品基础信息的系统!功能强大!

unit ReportBase;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, DB, ADODB, FR_DSet, FR_DBSet, FR_Class, ComCtrls, StdCtrls,
   ExtCtrls, Comobj, Base, wwdbdatetimepicker;

type
   TfrmReportBase = class(TfrmBase)
      Panel1: TPanel;
      GroupBox1: TGroupBox;
      Label1: TLabel;
      Button1: TButton;
      Button2: TButton;
      DateTimePicker1: TDateTimePicker;
      Button3: TButton;
      frDBDataSet1: TfrDBDataSet;
      ADOStoredProc1: TADOStoredProc;
      frReport1: TfrReport;
      procedure Button3Click(Sender: TObject);
      procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
   private
      function S_IsFileInUse(FileName: string): Boolean;
      { Private declarations }
   public
      { Public declarations }
   end;

var
   frmReportBase    : TfrmReportBase;

implementation

uses DataModule;

{$R *.dfm}

function TfrmReportBase.S_IsFileInUse(FileName: string): Boolean;
var
   HFileRes         : HFILE;
begin
   Result := False;
   if not FileExists(FileName) then
      exit;
   HFileRes := CreateFile(pchar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Result := (HFileRes = INVALID_HANDLE_VALUE);
   if not Result then
      CloseHandle(HFileRes);
end;

procedure TfrmReportBase.Button3Click(Sender: TObject);
var
   ExcelApp         : variant;
   SaveDialog1      : TSaveDialog;
   i, j, row, column: Integer;
begin
   inherited;
   with ADOStoredProc1 do
   begin
      close;
      ADOStoredProc1.parameters.ParamByName('@enddate').Value := FormatDateTime('yyyy-mm-dd', DateTimePicker1.Date);
      Open;
      if ADOStoredProc1.IsEmpty then
      begin
         showmessage('没有数据需要存盘！'); //test
         exit;
      end;
      SaveDialog1 := TSaveDialog.create(nil);
      SaveDialog1.Filter := 'Excel 文件 (*.xls)|*.xls';
      SaveDialog1.Title := '确定另存为excel的文件名';
      if SaveDialog1.Execute then
      begin
         while S_IsFileInUse(SaveDialog1.FileName) do
         begin
            case Application.MessageBox(pchar('无法存盘，' + string(ExtractFileName(SaveDialog1.FileName)) + '正在使用中'), '请确认', MB_ICONQuestion + MB_ABORTRETRYIGNORE + MB_DEFBUTTON2) of
               IDAbort:
                  begin
                     SaveDialog1.Free;
                     exit;
                  end;
               IDRetry:
                  begin
                     continue;
                  end;
               IDIgnore:
                  begin
                     if not SaveDialog1.Execute then Break;
                  end;
            end;
         end;
      end
      else
      begin
         SaveDialog1.Free;
         exit;
      end;                              //if
      try
         ExcelApp := CreateOleObject('Excel.Application'); //首先创建 Excel 对象，使用ComObj
      except
         Application.MessageBox('Excel没有安装!', 'Hello', MB_ICONERROR + MB_OK);
         abort;
      end;                              //end try
      try
         ExcelApp.visible := False;     //显示当前窗口
         ExcelApp.Caption := '应用程序调用 Microsoft Excel'; //更改 Excel 标题栏
         ExcelApp.WorkBooks.Add;        //添加新工作簿：
         ExcelApp.WorkSheets['Sheet1'].Activate; //设置第1个工作表为活动工作表
         ExcelApp.ActiveSheet.Rows[1].Font.Size := 10;
         ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
         row := 1;
         column := 1;
         for j := 0 to ADOStoredProc1.FieldCount - 1 do
         begin
            ExcelApp.Cells[row, column].Value := ADOStoredProc1.Fields[j].DisplayLabel;
            column := column + 1;
         end;
         row := 2;
         while (not ADOStoredProc1.Eof) and (not ADOStoredProc1.IsEmpty) do
         begin
            column := 1;
            for i := 1 to ADOStoredProc1.FieldCount do
            begin
               ExcelApp.Cells[row, column].Value := ADOStoredProc1.Fields[i - 1].asString;
               column := column + 1;
            end;
            ADOStoredProc1.Next;
            row := row + 1;
         end;
         if not S_IsFileInUse(SaveDialog1.FileName) then
         try
            ExcelApp.ActiveWorkBook.SaveAs(SaveDialog1.FileName);
         except
            SaveDialog1.Free;
            ExcelApp.WorkBooks.close;
            ExcelApp.Quit;
            ExcelApp := Unassigned;
            exit;
         end;
         SaveDialog1.Free;
         ExcelApp.WorkBooks.close;
         ExcelApp.Quit;
         ExcelApp := Unassigned;
         Application.MessageBox('Excel文件导出成功!', '成功', MB_OK);
      except
         SaveDialog1.Free;
         ExcelApp := Unassigned;
      end;
   end;
end;

procedure TfrmReportBase.Button2Click(Sender: TObject);
begin
   // frmReportBase.close;
end;

procedure TfrmReportBase.FormCreate(Sender: TObject);
begin
  inherited;
  DateTimePicker1.Date:=Now();
end;

end.