unit uRptPresupuestosCliente_Server; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, frxClass, frxDBSet, uDAScriptingProvider, uDADataTable, uDACDSDataTable, DB, uDAClasses, uDABINAdapter, uROTypes, uDAInterfaces, uDAMemDataTable, uDADataStreamer, uDABin2DataStreamer, frxGradient, frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDAEngine, IBSQL, IBDatabase, IBCustomDataSet, IBQuery, frxExportPDF, FactuGES_Intf; type TRptPresupuestosCliente = class(TDataModule) DADSCabecera: TDADataSource; DADSDetalles: TDADataSource; frxBarCodeObject1: TfrxBarCodeObject; frxOLEObject1: TfrxOLEObject; frxCrossObject1: TfrxCrossObject; frxCheckBoxObject1: TfrxCheckBoxObject; frxGradientObject1: TfrxGradientObject; frxDBCabecera: TfrxDBDataset; frxDBDetalles: TfrxDBDataset; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; frxReport: TfrxReport; IBDatabase1: TIBDatabase; IBTransaction1: TIBTransaction; DataSource1: TDataSource; DataSource2: TDataSource; capitulos: TIBQuery; DataSource3: TDataSource; detalles: TIBQuery; DataSource4: TDataSource; resumen: TIBQuery; resumenID: TIntegerField; resumenID_PRESUPUESTO: TIntegerField; resumenPOSICION: TIntegerField; resumenTIPO_DETALLE: TIBStringField; resumenCONCEPTO: TIBStringField; resumenIMPORTE_TOTAL: TIBBCDField; resumenVISIBLE: TSmallintField; frxDBCapitulos: TfrxDBDataset; frxDBResumen: TfrxDBDataset; DABin2DataStreamer1: TDABin2DataStreamer; cabecera: TIBQuery; cabeceraID: TIntegerField; cabeceraID_EMPRESA: TIntegerField; cabeceraFECHA_PRESUPUESTO: TDateField; cabeceraREFERENCIA: TIBStringField; cabeceraPORTADA: TMemoField; cabeceraMEMORIA: TMemoField; cabeceraOBSERVACIONES: TMemoField; cabeceraIMPORTE_NETO: TIBBCDField; cabeceraIMPORTE_PORTE: TIBBCDField; cabeceraDESCUENTO: TFloatField; cabeceraIMPORTE_DESCUENTO: TIBBCDField; cabeceraBASE_IMPONIBLE: TIBBCDField; cabeceraIVA: TFloatField; cabeceraID_CLIENTE: TIntegerField; cabeceraREFERENCIA_CLIENTE: TIBStringField; cabeceraCLIENTE_FINAL: TIBStringField; cabeceraNIF_CIF: TIBStringField; cabeceraNOMBRE: TIBStringField; cabeceraIMPORTE_IVA: TIBBCDField; cabeceraIMPORTE_TOTAL: TIBBCDField; cabeceraPERSONA_CONTACTO: TIBStringField; cabeceraCALLE: TIBStringField; cabeceraPOBLACION: TIBStringField; cabeceraPROVINCIA: TIBStringField; cabeceraCODIGO_POSTAL: TIBStringField; DADSCapitulos: TDADataSource; tbl_Capitulos: TDAMemDataTable; DADSResumen: TDADataSource; tbl_Resumen: TDAMemDataTable; DAMemDataTable1: TDAMemDataTable; DAMemDataTable2: TDAMemDataTable; frxPDFExport1: TfrxPDFExport; DADSInformeListadoPresupuestos: TDADataSource; tbl_InformeListadoPresupuestos: TDAMemDataTable; frxDBInformeListadoPresupuestos: TfrxDBDataset; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; procedure _GenerarPresupuesto(const AID : Integer); function _GenerarInforme(const TipoInforme: String; const IdEmpresa: Integer; const FechaInicio: DateTime; const FechaFin: DateTime; const ListaIDClientes: TIntegerArray; const ImporteMinimo: Currency): Binary; public function GenerarPresupuesto(const ListaID : TIntegerArray): Binary; function GenerarPresupuestoEnPDF(const ListaID : TIntegerArray): Binary; function GenerarInformeListadoPresupuestos(const IdEmpresa: Integer; const FechaInicio: DateTime; const FechaFin: DateTime; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, uDataModuleServer, schPresupuestosClienteClient_Intf; const rptInforme = 'InfPresupuestoCliente.fr3'; rptInformeListadoPresupuestosDesglosado = 'InformeListadoPresupuestosDesglosado.fr3'; rptInformeListadoPresupuestos = 'InformeListadoPresupuestos.fr3'; { TRptPresupuestosProveedor } procedure TRptPresupuestosCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; frxDBCabecera.DataSource := DADSCabecera; frxDBCapitulos.DataSource := DADSCapitulos; frxDBDetalles.DataSource := DADSDetalles; frxDBResumen.DataSource := DADSResumen; end; function TRptPresupuestosCliente.GenerarPresupuestoEnPDF(const ListaID: TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los presupuestos recibidos for i := 0 to ListaID.Count - 1 do _GenerarPresupuesto(ListaID.Items[i]); frxPDFExport1.Stream := Result; frxReport.Export(frxPDFExport1) finally end; end; function TRptPresupuestosCliente.GenerarInformeListadoPresupuestos( const IdEmpresa: Integer; const FechaInicio, FechaFin: DateTime; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; var ATipoInforme: String; begin //DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSARÁ POR CLIENTE if Desglosado then ATipoInforme := rptInformeListadoPresupuestosDesglosado else ATipoInforme := rptInformeListadoPresupuestos; Result := _GenerarInforme(ATipoInforme, IdEmpresa, FechaInicio, FechaFin, ListaIDClientes, ImporteMinimo); end; function TRptPresupuestosCliente.GenerarPresupuesto(const ListaID: TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los presupuestos recibidos for i := 0 to ListaID.Count - 1 do _GenerarPresupuesto(ListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; function TRptPresupuestosCliente._GenerarInforme(const TipoInforme: String; const IdEmpresa: Integer; const FechaInicio, FechaFin: DateTime; const ListaIDClientes: TIntegerArray; const ImporteMinimo: Currency): Binary; var Condicion: TDAWhereExpression; i: Integer; AInforme: Variant; begin Result := Binary.Create; FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try if tbl_InformeListadoPresupuestos.Active then tbl_InformeListadoPresupuestos.Active := False; // Filtrar el informe por empresa with tbl_InformeListadoPresupuestos.DynamicWhere do begin // (ID_EMPRESA >= ID) Condicion := NewBinaryExpression(NewField('', fld_PresupuestosClienteID_EMPRESA), NewConstant(IdEmpresa, datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; // Filtrar el informe por fechas if not VarIsNull(FechaInicio) and not VarIsNull(FechaFin) then begin with tbl_InformeListadoPresupuestos.DynamicWhere do begin // (FECHA_INICIO between FECHA_FIN) Condicion := NewBinaryExpression(NewField('', fld_PresupuestosClienteFECHA_PRESUPUESTO), NewConstant(FechaInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_PresupuestosClienteFECHA_PRESUPUESTO), NewConstant(FechaFin, datDateTime), dboLessOrEqual), Condicion, dboAnd); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; // Filtrar el informe por cliente if Assigned(ListaIDClientes) then begin with tbl_InformeListadoPresupuestos.DynamicWhere do begin for i := 0 to ListaIDClientes.Count - 1 do begin // (ID_CLIENTE = ID) Condicion := NewBinaryExpression(NewField('', fld_PresupuestosClienteID_CLIENTE), NewConstant(ListaIDClientes.Items[i], datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; end; // Filtrar el informe por importe minimo if (ImporteMinimo > 0) then begin with tbl_InformeListadoPresupuestos.DynamicWhere do begin // (IMPORTE_TOTAL > ImporteMinimo) Condicion := NewBinaryExpression(NewField('', fld_PresupuestosClienteIMPORTE_TOTAL), NewConstant(ImporteMinimo, datCurrency), dboGreaterOrEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; tbl_InformeListadoPresupuestos.Active := True; AInforme := DarRutaFichero(DarRutaInformes, TipoInforme, tbl_InformeListadoPresupuestos.FieldByName('ID_EMPRESA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarInforme, no encuentra informe' + TipoInforme)); frxReport.LoadFromFile(AInforme, True); frxReport.Variables.Variables['FechaInicio'] := FechaInicio; frxReport.Variables.Variables['FechaFin'] := FechaFin; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; procedure TRptPresupuestosCliente._GenerarPresupuesto(const AID: Integer); var AInforme: Variant; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Cabecera.Active := False; tbl_Capitulos.Active := False; tbl_Detalles.Active := False; tbl_Resumen.Active := False; tbl_Cabecera.ParamByName('ID').AsInteger := AID; tbl_Capitulos.ParamByName('ID_PRESUPUESTO').AsInteger := AID; tbl_Detalles.ParamByName('ID_PRESUPUESTO').AsInteger := AID; tbl_Resumen.ParamByName('ID_PRESUPUESTO').AsInteger := AID; tbl_Cabecera.Active := True; tbl_Capitulos.Active := True; tbl_Detalles.Active := True; tbl_Resumen.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarPresupuesto, no encuentra informe' + rptInforme)); frxReport.LoadFromFile(AInforme, True); frxReport.PrepareReport(False); finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; end.