unit uRptRecibosCliente_Server; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, frxClass, frxDBSet, uDAScriptingProvider, uDADataTable, uDACDSDataTable, DB, uDAClasses, frxChart, frxGradient, frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDABINAdapter, uROTypes, uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAMemDataTable, FactuGES_Intf; 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; Bin2DataStreamer: TDABin2DataStreamer; tbl_InformeListadoRecibos: TDAMemDataTable; DADSInformeListadoRecibos: TDADataSource; frxDBInformeListadoRecibos: TfrxDBDataset; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; procedure _GenerarRecibo(const ID : Integer); function _GenerarInforme(const TipoInforme: String; const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const FechaVenInicio: Variant; FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const ImporteMinimo: Currency): 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 uROServer, uSistemaFunc, uNumUtils, uDataModuleServer, schRecibosClienteClient_Intf; const rptInforme = 'InfReciboCliente.fr3'; rptInformeListadoRecibosClienteDesglosado = 'InformeListadoRecibosClienteDesglosado.fr3'; rptInformeListadoRecibosCliente = 'InformeListadoRecibosCliente.fr3'; rptInformeListadoRecibosCliPendientes = 'InformeListadoRecibosCliPendientes.fr3'; rptInformeListadoRecibosCliPendientesDesglosado = 'InformeListadoRecibosCliPendientesDesglosado.fr3'; { TRptReciboCliente } procedure TRptRecibosCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; 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; begin //DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSARÁ POR CLIENTE if Desglosado then ATipoInforme := rptInformeListadoRecibosClienteDesglosado else ATipoInforme := rptInformeListadoRecibosCliente; Result := _GenerarInforme(ATipoInforme, IdEmpresa, FechaInicio, FechaFin, FechaVenInicio, FechaVenFin, ListaIDClientes, ImporteMinimo); 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; begin if tbl_InformeListadoRecibos.Active then tbl_InformeListadoRecibos.Active := False; // Filtrar el informe por situacion with tbl_InformeListadoRecibos.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; //DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSARÁ POR CLIENTE if Desglosado then ATipoInforme := rptInformeListadoRecibosCliPendientesDesglosado else ATipoInforme := rptInformeListadoRecibosCliPendientes; Result := _GenerarInforme(ATipoInforme, IdEmpresa, FechaInicio, FechaFin, FechaVenInicio, FechaVenFin, ListaIDClientes, ImporteMinimo); 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; function TRptRecibosCliente._GenerarInforme(const TipoInforme: String; const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const FechaVenInicio: Variant; FechaVenFin: Variant; const ListaIDClientes: TIntegerArray; const ImporteMinimo: Currency): Binary; var Condicion: TDAWhereExpression; i: Integer; AInforme: Variant; Intf : IInterface; AClientID: TGUID; AEmpresasService : IsrvEmpresas; ATextos : TStringList; begin Result := Binary.Create; FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" ATextos := TStringList.Create; try if tbl_InformeListadoRecibos.Active then tbl_InformeListadoRecibos.Active := False; // Filtrar el informe por empresa with tbl_InformeListadoRecibos.DynamicWhere do begin // (ID_EMPRESA >= ID) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteID_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_InformeListadoRecibos.DynamicWhere do begin // (FECHA_INICIO between FECHA_FIN) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_EMISION), NewConstant(FechaInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_EMISION), NewConstant(FechaFin, 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(FechaVenInicio) and not VarIsNull(FechaVenFin) then begin with tbl_InformeListadoRecibos.DynamicWhere do begin // (FECHA_VENCIMIENTO_INICIO between FECHA_VENCIMIENTO_FIN) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_VENCIMIENTO), NewConstant(FechaVenInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_RecibosClienteFECHA_VENCIMIENTO), NewConstant(FechaVenFin, 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_InformeListadoRecibos.DynamicWhere do begin for i := 0 to ListaIDClientes.Count - 1 do begin // (ID_CLIENTE = ID) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteID_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_InformeListadoRecibos.DynamicWhere do begin // (IMPORTE_TOTAL > ImporteMinimo) Condicion := NewBinaryExpression(NewField('', fld_RecibosClienteIMPORTE_TOTAL), NewConstant(ImporteMinimo, datCurrency), dboGreaterOrEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; tbl_InformeListadoRecibos.Active := True; AInforme := DarRutaFichero(DarRutaInformes, TipoInforme, IntToStr(IDEmpresa)); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarInforme, no encuentra informe ' + TipoInforme)); frxReport.LoadFromFile(AInforme, True); CreateGUID(AClientID); GetClassFactory('srvEmpresas').CreateInstance(AClientID, Intf); AEmpresasService := Intf as IsrvEmpresas; ATextos.Add(AEmpresasService.DarNombre(IdEmpresa)); frxReport.Variables.Variables['TextoParametros'] := ATextos.Text; frxReport.Variables.Variables['FechaInicio'] := FechaInicio; frxReport.Variables.Variables['FechaFin'] := FechaFin; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); finally FreeAndNil(ATextos); FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; 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, tbl_Cabecera.FieldByName('ID_TIENDA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarRecibo, no encuentra informe ' + rptInforme)); frxReport.LoadFromFile(AInforme, True); frxReport.Variables.Variables['ImporteLetras'] := QuotedStr(CifraToLetras(tbl_Cabecera.FieldByName('IMPORTE_TOTAL').AsFloat)); frxReport.ReportOptions.Name := 'Recibo de cliente ' + tbl_Cabecera.FieldByName('REFERENCIA').AsString; frxReport.PrepareReport(False); finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; end.