unit uRptRecibosCliente_Server; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, frxClass, frxDBSet, uDAScriptingProvider, uDADataTable, uDAMemDataTable, DB, uDAClasses, frxChart, frxGradient, frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDABINAdapter, uROTypes, uDAInterfaces, uDADataStreamer, FactuGES_Intf, uDABin2DataStreamer; type TRptRecibosCliente = class(TDataModule) DADataCabecera: TDADataSource; tbl_Cabecera: TDAMemDataTable; frxRichObject1: TfrxRichObject; frxBarCodeObject1: TfrxBarCodeObject; frxOLEObject1: TfrxOLEObject; frxCrossObject1: TfrxCrossObject; frxCheckBoxObject1: TfrxCheckBoxObject; frxGradientObject1: TfrxGradientObject; frxChartObject1: TfrxChartObject; frxDBCabecera: TfrxDBDataset; DADataCompensados: TDADataSource; frxDBCompensados: TfrxDBDataset; tbl_Compensados: TDAMemDataTable; frxReport: TfrxReport; tbl_InformeListadoRecibos: TDAMemDataTable; DADSInformeListadoRecibos: TDADataSource; frxDBInformeListadoRecibos: TfrxDBDataset; Bin2DataStreamer: TDABin2DataStreamer; frxDBInformeListadoRecibosResumen: TfrxDBDataset; DADSInformeListadoRecibosResumen: TDADataSource; tbl_InformeListadoRecibosResumen: TDAMemDataTable; frxDBInformeListadoRecibosPendientes: TfrxDBDataset; DADSInformeListadoRecibosPendientes: TDADataSource; tbl_InformeListadoRecibosPendientes: TDAMemDataTable; frxDBInformeListadoRecibosPendResumen: TfrxDBDataset; DADSInformeListadoRecibosPendResumen: TDADataSource; tbl_InformeListadoRecibosPendResumen: TDAMemDataTable; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; FIdEmpresa: Integer; FFechaInicio: Variant; FFechaFin: Variant; FFechaVenInicio: Variant; FFechaVenFin: Variant; FListaIDClientes: TIntegerArray; FImporteMinimo: Currency; procedure _GenerarRecibo(const ID : Integer); procedure PrepararTablaInforme(ATabla: TDAMemDataTable); procedure PrepararTablaResumenInforme(ATabla: IDADataset); function _GenerarInforme(const TipoInforme: String): Binary; public function GenerarRecibo(const ListaID : TIntegerArray): Binary; function GenerarInformeListadoRecibos(const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const FechaVenInicio: Variant; FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; function GenerarInformeListadoRecibosPendientes(const IdEmpresa: Integer; const FechaInicio: Variant; const FechaFin: Variant; const FechaVenInicio: Variant; const FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, StrUtils, uDataModuleServer, schRecibosClienteClient_Intf; const rptInforme = 'InfReciboCliente.fr3'; rptInformeListadoRecibosClienteDesglosado = 'InformeListadoRecibosClienteDesglosado.fr3'; rptInformeListadoRecibosCliente = 'InformeListadoRecibosCliente.fr3'; rptInformeListadoRecibosCliPendientes = 'InformeListadoRecibosCliPendientes.fr3'; rptInformeListadoRecibosCliPendientesDesglosado = 'InformeListadoRecibosCliPendientesDesglosado.fr3'; { Dataset names for schReport } ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeCompensados = 'Informe_Compensados'; ds_InformeListadoRecibosResumen = 'InformeListadoRecibosResumen'; ds_InformeListadoRecibosPendientesResumen = 'InformeListadoRecibosPendientesResumen'; { TRptReciboCliente } procedure TRptRecibosCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; frxDBCabecera.DataSource := DADataCabecera; frxDBCompensados.DataSource := DADataCompensados; end; function TRptRecibosCliente.GenerarRecibo(const ListaID: TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los albaranes recibidos for i := 0 to ListaID.Count - 1 do _GenerarRecibo(ListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; procedure TRptRecibosCliente.PrepararTablaInforme(ATabla: TDAMemDataTable); var Condicion: TDAWhereExpression; i: Integer; begin // Filtrar el informe por empresa with ATabla.DynamicWhere do begin // (ID_EMPRESA >= ID) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteID_EMPRESA), NewConstant(FIdEmpresa, datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; // Filtrar el informe por fechas if not VarIsNull(FFechaInicio) and not VarIsNull(FFechaFin) then begin with ATabla.DynamicWhere do begin // (FECHA_INICIO between FECHA_FIN) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_EMISION), NewConstant(FFechaInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_EMISION), NewConstant(FFechaFin, datDateTime), dboLessOrEqual), Condicion, dboAnd); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; // Filtrar el informe por fechas de vencimiento if not VarIsNull(FFechaVenInicio) and not VarIsNull(FFechaVenFin) then begin with ATabla.DynamicWhere do begin // (FECHA_VENCIMIENTO_INICIO between FECHA_VENCIMIENTO_FIN) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_VENCIMIENTO), NewConstant(FFechaVenInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_VENCIMIENTO), NewConstant(FFechaVenFin, datDateTime), dboLessOrEqual), Condicion, dboAnd); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; // Filtrar el informe por proveedor if Assigned(FListaIDClientes) then begin with ATabla.DynamicWhere do begin for i := 0 to FListaIDClientes.Count - 1 do begin // (ID_PROVEEDOR = ID) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteID_CLIENTE), NewConstant(FListaIDClientes.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 (FImporteMinimo > 0) then begin with ATabla.DynamicWhere do begin // (IMPORTE_TOTAL > ImporteMinimo) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteIMPORTE_TOTAL), NewConstant(FImporteMinimo, datCurrency), dboGreaterOrEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; end; procedure TRptRecibosCliente.PrepararTablaResumenInforme(ATabla: IDADataset); var i: Integer; AWhereStr : String; begin // Filtrar el informe por empresa AWhereStr := ' (' + fld_RecibosClienteID_EMPRESA + ' = ' + IntToStr(FIdEmpresa) + ') '; // Filtrar el informe por fechas if not VarIsNull(FFechaInicio) and not VarIsNull(FFechaFin) then begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_RecibosClienteFECHA_EMISION + ' between ''' + ReplaceStr(VarToStr(FFechaInicio),'/','.') + ''' and ''' + ReplaceStr(VarToStr(FFechaFin),'/','.') + ''') '; end; // Filtrar el informe por fechas de vencimiento if not VarIsNull(FFechaVenInicio) and not VarIsNull(FFechaVenFin) then begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_RecibosClienteFECHA_VENCIMIENTO + ' between ''' + ReplaceStr(VarToStr(FFechaVenInicio),'/','.') + ''' and ''' + ReplaceStr(VarToStr(FFechaVenFin),'/','.') + ''') '; end; // Filtrar el informe por proveedor if Assigned(FListaIDClientes) then begin for i := 0 to FListaIDClientes.Count - 1 do begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_RecibosClienteID_CLIENTE + ' = ' + IntToStr(FListaIDClientes.Items[i]) + ') '; end; end; // Filtrar el informe por importe minimo if (FImporteMinimo > 0) then begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_RecibosClienteIMPORTE_TOTAL + ' >= ' + CurrToStr(FImporteMinimo) + ') '; end; ATabla.Where.AddText(AWhereStr); end; function TRptRecibosCliente.GenerarInformeListadoRecibos( const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const FechaVenInicio: Variant; FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; var ATipoInforme: String; AStream: TMemoryStream; dsMaster: IDADataset; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" AStream := TMemoryStream.Create; try //Inicializamos parametros FIdEmpresa := IdEmpresa; FFechaInicio := FechaInicio; FFechaFin := FechaFin; FFechaVenInicio := FechaVenInicio; FFechaVenFin := FechaVenFin; FImporteMinimo := ImporteMinimo; if Assigned(FListaIDClientes) then FListaIDClientes.Free; FListaIDClientes := ListaIDClientes; //Se prepara la tabla del listado general del informe if tbl_InformeListadoRecibos.Active then tbl_InformeListadoRecibos.Active := False; PrepararTablaInforme(tbl_InformeListadoRecibos); //Se prepara la tabla del listado resumen del informe if tbl_InformeListadoRecibosResumen.Active then tbl_InformeListadoRecibosResumen.Active := False; dsMaster := schReport.NewDataset(FConnection, ds_InformeListadoRecibosResumen, [], [], False); PrepararTablaResumenInforme(dsMaster); // Filtrar el informe por situacion //Esto se hace para rellenar la tabla del datamodule que usa el informe. dsMaster.Open; AStream.Clear; Bin2DataStreamer.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1); Bin2DataStreamer.ReadDataset(AStream, tbl_InformeListadoRecibosResumen, TRUE, '', TRUE, TRUE); //DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSARÁ POR CLIENTE if Desglosado then ATipoInforme := rptInformeListadoRecibosClienteDesglosado else ATipoInforme := rptInformeListadoRecibosCliente; //Finalmente se abren las tablas del informe tbl_InformeListadoRecibos.Active := True; tbl_InformeListadoRecibosResumen.Active := True; Result := _GenerarInforme(ATipoInforme); finally AStream.Free; dsMaster := Nil; FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; function TRptRecibosCliente.GenerarInformeListadoRecibosPendientes( const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const FechaVenInicio, FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; var Condicion: TDAWhereExpression; ATipoInforme: String; AStream: TMemoryStream; dsMaster: IDADataset; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" AStream := TMemoryStream.Create; try //Inicializamos parametros FIdEmpresa := IdEmpresa; FFechaInicio := FechaInicio; FFechaFin := FechaFin; FFechaVenInicio := FechaVenInicio; FFechaVenFin := FechaVenFin; FImporteMinimo := ImporteMinimo; if Assigned(FListaIDClientes) then FListaIDClientes.Free; FListaIDClientes := ListaIDClientes; //Se prepara la tabla del listado general del informe if tbl_InformeListadoRecibosPendientes.Active then tbl_InformeListadoRecibosPendientes.Active := False; PrepararTablaInforme(tbl_InformeListadoRecibosPendientes); // Filtrar el informe por situacion with tbl_InformeListadoRecibosPendientes.DynamicWhere do begin // (ID_EMPRESA >= ID) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteSITUACION), NewConstant('COBRADO', datString), dboNotEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; //Se prepara la tabla del listado resumen del informe if tbl_InformeListadoRecibosPendResumen.Active then tbl_InformeListadoRecibosPendResumen.Active := False; dsMaster := schReport.NewDataset(FConnection, ds_InformeListadoRecibosPendientesResumen, [], [], False); PrepararTablaResumenInforme(dsMaster); // Filtrar el informe por situacion dsMaster.Where.AddText(' AND (SITUACION <> ''COBRADO'')'); //Esto se hace para rellenar la tabla del datamodule que usa el informe. dsMaster.Open; AStream.Clear; Bin2DataStreamer.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1); Bin2DataStreamer.ReadDataset(AStream, tbl_InformeListadoRecibosPendResumen, TRUE, '', TRUE, TRUE); //DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSARÁ POR CLIENTE if Desglosado then ATipoInforme := rptInformeListadoRecibosCliPendientesDesglosado else ATipoInforme := rptInformeListadoRecibosCliPendientes; //Finalmente se abren las tablas del informe tbl_InformeListadoRecibosPendientes.Active := True; tbl_InformeListadoRecibosPendResumen.Active := True; Result := _GenerarInforme(ATipoInforme); finally AStream.Free; dsMaster := Nil; FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; function TRptRecibosCliente._GenerarInforme(const TipoInforme: String): Binary; var AInforme: Variant; begin Result := Binary.Create; AInforme := DarRutaFichero(DarRutaInformes, TipoInforme, IntToStr(FIDEmpresa)); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarInforme, no encuentra informe ' + TipoInforme)); frxReport.LoadFromFile(AInforme, True); frxReport.Variables.Variables['FechaInicio'] := FFechaInicio; frxReport.Variables.Variables['FechaFin'] := FFechaFin; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); end; procedure TRptRecibosCliente._GenerarRecibo(const ID: Integer); var AInforme: Variant; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Cabecera.Active := False; tbl_Compensados.Active := False; tbl_Cabecera.ParamByName('ID').AsInteger := ID; tbl_Compensados.ParamByName('ID_RECIBO').AsInteger := ID; tbl_Cabecera.Active := True; tbl_Compensados.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarRecibo, 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.