rptexcel.pas

感应IC卡电脑考勤、门禁、售饭一卡通管理系统是基于我公司开发生产的ESW型智能卡记录器所具有的对持卡人刷卡卡号、时间、次数进行读取贮存等功能

unit RptExcel;

interface

uses TimeIntField,registry,db,Clipbrd,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, OleServer, OleCtnrs,
  Excel97, Quickrpt, QRCtrls, Variants, Excel2000, FR_DSet, FR_DBSet,
  FR_Class, FR_Desgn, ADODB, ADOQry;

type
  TfrmRptExcel = class(TForm)
    Panel1: TPanel;
    lblMsg: TLabel;
    cmdCancel: TButton;
    Animate1: TAnimate;
    SaveDialog1: TSaveDialog;
    oOleDoc: TOleContainer;
    qryRpts: TADOQry;
    qryRptsRptName: TStringField;
    qryRptsExcelDoc: TBlobField;
    oExcelApp: TExcelApplication;
    frReport1: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    frDesigner1: TfrDesigner;
    procedure FormCreate(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    lCancel :Boolean;
	procedure QuickRpt(tnPrintTo:integer; sRptName:string;
									oDataSet:TDataSet; sArgs: array of Variant);
	procedure FastRpt(tnPrintTo:integer; sRptName:string;
									oDataSet:TDataSet; sArgs: array of Variant);
  public
  	nPrintTo :integer;
	procedure PrintRpt(tnPrintTo:integer; sRptName:string;
    	oDataSet:TDataSet; sArgs: array of Variant); overload;

	procedure PrintRpt(sRptName:string;
    	oDataSet:TDataSet; sArgs: array of Variant); overload;
	procedure PrintRpt(sRptName:string;
    	oDataSet:TDataSet); overload;

	procedure PrintRpt(sRptName:string; oDataSet:TDataSet;
    	sArgs: array of Variant; oDataSetH:TDataSet); overload;
	procedure PrintRpt(sRptName:string; oDataSet:TDataSet;
        oDataSetH:TDataSet); overload;
    { Public declarations }
  end;

var
  frmRptExcel: TfrmRptExcel;

implementation

uses SelfFunc, Main;

{$R *.DFM}

procedure TfrmRptExcel.QuickRpt(tnPrintTo:integer; sRptName:string;
									oDataSet:TDataSet; sArgs: array of Variant);
var oReport :TQuickRep;
	nArgs :integer;

	procedure SetRptDataSet(oParent:TWinControl);
    var i,k :integer;
    	oControl :TWinControl;
        ts :string;
        tv :Variant;
    begin
      for i :=oParent.ControlCount -1 downto 0 do
      if oParent.Controls[i] is TWinControl then
      begin
      	oControl :=TWinControl(oParent.Controls[i]);
        if oControl is TQRDBText then TQRDBText(oControl).DataSet :=oDataSet
        else if oControl is TQRDBImage then TQRDBImage(oControl).DataSet :=oDataSet
        else if oControl is TQRBand then SetRptDataSet(oControl)
        else if oControl is TQRSubDetail then
        begin
        	TQRSubDetail(oControl).DataSet :=oDataSet;
        	SetRptDataSet(oControl);
        end
        else if oControl is TQRLabel then
		begin
          ts :=TQRLabel(oControl).Caption;
          if Copy(ts,1,1) = '=' then
          begin
          	Delete(ts,1,1);
            for k :=0 to nArgs -1 do
            if (sArgs[k*2] =ts) then
            begin
              tv :=sArgs[k*2 +1];
              case VarType(tv) of
				varEmpty, varNull:  ts:='';
				varSmallint, varInteger:  ts:=IntToStr(tv);
				varSingle, varCurrency:  ts:=FloatToStr(tv);
                varDouble:
                  begin
                  	if Pos('ら戳', ts) >0 then ts :=DateToStr(tv)
                    else ts :=FloatToStr(tv);
                  end;
				varDate:  ts:=DateToStr(tv);
				varString:  ts:=tv;
                else ts:='';
              end;
              TQRLabel(oControl).Caption :=ts;
              Break;
            end;
          end;
        end;
      end;
    end;

begin
    if (sArgs[0] ='') then nArgs :=0
	else nArgs :=Trunc(High(sArgs)/2) +1;

	oReport :=TQuickRep.Create(nil);
  try
    ReadComponentResFile(sRptName, oReport);
    oReport.DataSet :=oDataSet;
    SetRptDataSet(oReport);
    if tnPrintTo =2 then oReport.Print
    else oReport.Preview;
  finally
  	oReport.Free;
  end;
end;

procedure TfrmRptExcel.FastRpt(tnPrintTo:integer; sRptName:string;
									oDataSet:TDataSet; sArgs: array of Variant);
begin
  try
  	frDBDataSet1.DataSet :=oDataSet;
    frReport1.LoadFromFile(sRptName);

    if tnPrintTo =2 then frReport1.PrintPreparedReportDlg 
    else if tnPrintTo =4 then
    begin
    	frReport1.DesignReport;
      	nPrintTo :=1; //ゴ