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; FIdEmpresa: Integer; FFechaInicio: Variant; FFechaFin: Variant; FFechaVenInicio: Variant; FFechaVenFin: Variant; FListaIDProveedores: TIntegerArray; FListaNombresProveedores: TStringList; FImporteMinimo: Currency; FDesglosado : Boolean; 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; procedure IniciarParametrosInforme; 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, 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 //Inicializamos parametros FIdEmpresa := IdEmpresa; FFechaInicio := FechaInicio; FFechaFin := FechaFin; FFechaVenInicio := FechaVenInicio; FFechaVenFin := FechaVenFin; FImporteMinimo := ImporteMinimo; FDesglosado := Desglosado; if Assigned(FListaIDProveedores) then FListaIDProveedores.Free; FListaIDProveedores := ListaIDClientes; //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 //Inicializamos parametros FIdEmpresa := IdEmpresa; FFechaInicio := FechaInicio; FFechaFin := FechaFin; FFechaVenInicio := FechaVenInicio; FFechaVenFin := FechaVenFin; FImporteMinimo := ImporteMinimo; FDesglosado := Desglosado; if Assigned(FListaIDProveedores) then FListaIDProveedores.Free; FListaIDProveedores := ListaIDClientes; 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; procedure TRptRecibosCliente.IniciarParametrosInforme; var ATextos : TStringList; ACadena : String; begin ATextos := TStringList.Create; try { if (not VarIsNull(FFechaInicio)) and (not VarIsNull(FFechaFin)) then ACadena := Format('Fechas de factura desde el %s hasta el %s', [VarToStr(FFechaInicio), VarToStr(FFechaFin)]) else ACadena := 'Sin rango de fechas'; ATextos.Add(ACadena); ACadena := ''; // Filtrar el informe por fechas de vencimiento if (not VarIsNull(FFechaVenInicio)) and (not VarIsNull(FFechaVenFin)) then begin ACadena := Format('Vencimientos desde el %s hasta el %s', [VarToStr(FFechaVenInicio), VarToStr(FFechaVenFin)]); ATextos.Add(ACadena); ACadena := ''; end; if (FImporteMinimo > 0) then begin ACadena := Format('Facturas con importe superior a %m', [FImporteMinimo]); ATextos.Add(ACadena); ACadena := ''; end; if Assigned(FListaIDProveedores) and (FListaIDProveedores.Count > 0) then begin RecuperarNombresProveedores; ACadena := FListaNombresProveedores.Text; end else begin ACadena := 'Todos los proveedores'; if FDesglosado then ACadena := ACadena + ' (desglosados)' end; } ATextos.Add(ACadena); ACadena := ''; frxReport.Variables.Variables['TextoParametros'] := ATextos.Text; finally FreeAndNil(ATextos); 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; begin Result := Binary.Create; FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" 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); 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 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.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.