2007-11-05 17:59:28 +00:00
unit uRptRecibosCliente_Server;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, frxClass, frxDBSet, uDAScriptingProvider,
2008-06-04 16:13:30 +00:00
uDADataTable, uDAMemDataTable, DB, uDAClasses, frxChart, frxGradient,
2007-11-05 17:59:28 +00:00
frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDABINAdapter, uROTypes,
2009-01-27 16:59:50 +00:00
uDAInterfaces, uDADataStreamer, FactuGES_Intf, uDABin2DataStreamer;
2007-11-05 17:59:28 +00:00
type
TRptRecibosCliente = class( TDataModule)
DADataCabecera: TDADataSource;
2008-06-04 16:13:30 +00:00
tbl_Cabecera: TDAMemDataTable;
2007-11-05 17:59:28 +00:00
frxRichObject1: TfrxRichObject;
frxBarCodeObject1: TfrxBarCodeObject;
frxOLEObject1: TfrxOLEObject;
frxCrossObject1: TfrxCrossObject;
frxCheckBoxObject1: TfrxCheckBoxObject;
frxGradientObject1: TfrxGradientObject;
frxChartObject1: TfrxChartObject;
frxDBCabecera: TfrxDBDataset;
DADataCompensados: TDADataSource;
frxDBCompensados: TfrxDBDataset;
2008-06-04 16:13:30 +00:00
tbl_Compensados: TDAMemDataTable;
frxReport: TfrxReport;
2008-10-17 16:36:44 +00:00
tbl_InformeListadoRecibos: TDAMemDataTable;
DADSInformeListadoRecibos: TDADataSource;
frxDBInformeListadoRecibos: TfrxDBDataset;
2009-01-27 16:59:50 +00:00
Bin2DataStreamer: TDABin2DataStreamer;
frxDBInformeListadoRecibosResumen: TfrxDBDataset;
DADSInformeListadoRecibosResumen: TDADataSource;
tbl_InformeListadoRecibosResumen: TDAMemDataTable;
frxDBInformeListadoRecibosPendientes: TfrxDBDataset;
DADSInformeListadoRecibosPendientes: TDADataSource;
tbl_InformeListadoRecibosPendientes: TDAMemDataTable;
frxDBInformeListadoRecibosPendResumen: TfrxDBDataset;
DADSInformeListadoRecibosPendResumen: TDADataSource;
tbl_InformeListadoRecibosPendResumen: TDAMemDataTable;
2007-11-05 17:59:28 +00:00
schReport: TDASchema;
DataDictionary: TDADataDictionary;
procedure DataModuleCreate( Sender: TObject) ;
private
FConnection: IDAConnection;
2009-01-27 16:59:50 +00:00
FIdEmpresa: Integer ;
FFechaInicio: Variant ;
FFechaFin: Variant ;
FFechaVenInicio: Variant ;
FFechaVenFin: Variant ;
FListaIDClientes: TIntegerArray;
FImporteMinimo: Currency ;
2008-08-22 14:52:35 +00:00
procedure _GenerarRecibo( const ID : Integer ) ;
2009-01-27 16:59:50 +00:00
procedure PrepararTablaInforme( ATabla: TDAMemDataTable) ;
procedure PrepararTablaResumenInforme( ATabla: IDADataset) ;
function _GenerarInforme( const TipoInforme: String ) : Binary;
2008-12-15 09:03:56 +00:00
2007-11-05 17:59:28 +00:00
public
2008-10-17 16:36:44 +00:00
function GenerarRecibo( const ListaID : TIntegerArray) : Binary;
2008-12-15 09:03:56 +00:00
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;
2007-11-05 17:59:28 +00:00
end ;
implementation
{$R *.dfm}
uses
2009-01-27 16:59:50 +00:00
uSistemaFunc, StrUtils, uDataModuleServer, schRecibosClienteClient_Intf;
2007-11-05 17:59:28 +00:00
const
rptInforme = 'InfReciboCliente.fr3' ;
2008-10-17 16:36:44 +00:00
rptInformeListadoRecibosClienteDesglosado = 'InformeListadoRecibosClienteDesglosado.fr3' ;
rptInformeListadoRecibosCliente = 'InformeListadoRecibosCliente.fr3' ;
2008-10-20 18:50:41 +00:00
rptInformeListadoRecibosCliPendientes = 'InformeListadoRecibosCliPendientes.fr3' ;
rptInformeListadoRecibosCliPendientesDesglosado = 'InformeListadoRecibosCliPendientesDesglosado.fr3' ;
2007-11-05 17:59:28 +00:00
{ Dataset names for schReport }
ds_InformeCabecera = 'Informe_Cabecera' ;
ds_InformeCompensados = 'Informe_Compensados' ;
2009-01-27 16:59:50 +00:00
ds_InformeListadoRecibosResumen = 'InformeListadoRecibosResumen' ;
ds_InformeListadoRecibosPendientesResumen = 'InformeListadoRecibosPendientesResumen' ;
2007-11-05 17:59:28 +00:00
{ TRptReciboCliente }
procedure TRptRecibosCliente. DataModuleCreate( Sender: TObject) ;
begin
schReport. ConnectionManager : = dmServer. ConnectionManager;
FConnection : = dmServer. DarNuevaConexion;
frxReport. EngineOptions. NewSilentMode : = simReThrow;
2008-09-24 14:41:41 +00:00
frxDBCabecera. DataSource : = DADataCabecera;
frxDBCompensados. DataSource : = DADataCompensados;
2007-11-05 17:59:28 +00:00
end ;
2008-08-22 14:52:35 +00:00
function TRptRecibosCliente. GenerarRecibo( const ListaID: TIntegerArray) : Binary;
2007-11-05 17:59:28 +00:00
var
i: Integer ;
begin
Result : = Binary. Create;
try
//Vamos generando todos y cada uno de los albaranes recibidos
2008-08-22 14:52:35 +00:00
for i : = 0 to ListaID. Count - 1 do
_GenerarRecibo( ListaID. Items[ i] ) ;
2007-11-05 17:59:28 +00:00
frxReport. PreviewPages. SaveToStream( Result ) ;
finally
end ;
end ;
2009-01-27 16:59:50 +00:00
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 ;
2008-10-21 17:58:25 +00:00
function TRptRecibosCliente. GenerarInformeListadoRecibos(
2008-12-15 09:03:56 +00:00
const IdEmpresa: Integer ; const FechaInicio, FechaFin: Variant ;
const FechaVenInicio: Variant ; FechaVenFin: Variant ;
2008-10-17 16:36:44 +00:00
const ListaIDClientes: TIntegerArray; const Desglosado: Boolean ;
const ImporteMinimo: Currency ) : Binary;
var
ATipoInforme: String ;
2009-01-27 16:59:50 +00:00
AStream: TMemoryStream;
dsMaster: IDADataset;
2008-10-17 16:36:44 +00:00
begin
2009-01-27 16:59:50 +00:00
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 ) ;
2008-10-17 16:36:44 +00:00
2009-01-27 16:59:50 +00:00
//DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSAR<41> POR CLIENTE
2008-10-17 16:36:44 +00:00
if Desglosado then
ATipoInforme : = rptInformeListadoRecibosClienteDesglosado
else
ATipoInforme : = rptInformeListadoRecibosCliente;
2009-01-27 16:59:50 +00:00
//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 ;
2008-10-17 16:36:44 +00:00
end ;
2008-10-21 17:58:25 +00:00
function TRptRecibosCliente. GenerarInformeListadoRecibosPendientes(
2008-12-15 09:03:56 +00:00
const IdEmpresa: Integer ; const FechaInicio, FechaFin: Variant ;
const FechaVenInicio, FechaVenFin: Variant ;
2008-10-17 16:36:44 +00:00
const ListaIDClientes: TIntegerArray; const Desglosado: Boolean ;
const ImporteMinimo: Currency ) : Binary;
var
Condicion: TDAWhereExpression;
2008-10-20 18:50:41 +00:00
ATipoInforme: String ;
2009-01-27 16:59:50 +00:00
AStream: TMemoryStream;
dsMaster: IDADataset;
2008-10-17 16:36:44 +00:00
begin
2009-01-27 16:59:50 +00:00
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) ;
2008-10-17 16:36:44 +00:00
// Filtrar el informe por situacion
2009-01-27 16:59:50 +00:00
with tbl_InformeListadoRecibosPendientes. DynamicWhere do
2008-10-17 16:36:44 +00:00
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 ;
2009-01-27 16:59:50 +00:00
//Se prepara la tabla del listado resumen del informe
if tbl_InformeListadoRecibosPendResumen. Active then
tbl_InformeListadoRecibosPendResumen. Active : = False ;
2008-10-17 16:36:44 +00:00
2009-01-27 16:59:50 +00:00
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<41> POR CLIENTE
2008-10-20 18:50:41 +00:00
if Desglosado then
ATipoInforme : = rptInformeListadoRecibosCliPendientesDesglosado
else
ATipoInforme : = rptInformeListadoRecibosCliPendientes;
2008-10-17 16:36:44 +00:00
2009-01-27 16:59:50 +00:00
//Finalmente se abren las tablas del informe
tbl_InformeListadoRecibosPendientes. Active : = True ;
tbl_InformeListadoRecibosPendResumen. Active : = True ;
2008-10-20 18:50:41 +00:00
2009-01-27 16:59:50 +00:00
Result : = _GenerarInforme( ATipoInforme) ;
finally
AStream. Free;
dsMaster : = Nil ;
FConnection. RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
end ;
2008-10-17 16:36:44 +00:00
end ;
2009-01-27 16:59:50 +00:00
function TRptRecibosCliente. _GenerarInforme( const TipoInforme: String ) : Binary;
2008-10-17 16:36:44 +00:00
var
2008-11-27 09:16:29 +00:00
AInforme: Variant ;
2008-10-17 16:36:44 +00:00
begin
Result : = Binary. Create;
2009-01-27 16:59:50 +00:00
AInforme : = DarRutaFichero( DarRutaInformes, TipoInforme, IntToStr( FIDEmpresa) ) ;
if VarIsNull( AInforme) then
raise Exception. Create ( ( 'Error Servidor: _GenerarInforme, no encuentra informe ' + TipoInforme) ) ;
2008-10-17 16:36:44 +00:00
2009-01-27 16:59:50 +00:00
frxReport. LoadFromFile( AInforme, True ) ;
frxReport. Variables. Variables[ 'FechaInicio' ] : = FFechaInicio;
frxReport. Variables. Variables[ 'FechaFin' ] : = FFechaFin;
2008-10-17 16:36:44 +00:00
2009-01-27 16:59:50 +00:00
frxReport. PrepareReport( False ) ;
frxReport. PreviewPages. SaveToStream( Result ) ;
2008-10-17 16:36:44 +00:00
end ;
2008-08-22 14:52:35 +00:00
procedure TRptRecibosCliente. _GenerarRecibo( const ID: Integer ) ;
2008-12-15 09:03:56 +00:00
var
2008-11-27 09:16:29 +00:00
AInforme: Variant ;
2008-12-15 09:03:56 +00:00
2007-11-05 17:59:28 +00:00
begin
2008-10-31 18:16:49 +00:00
FConnection. BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
try
tbl_Cabecera. Active : = False ;
tbl_Compensados. Active : = False ;
2007-11-05 17:59:28 +00:00
2008-10-31 18:16:49 +00:00
tbl_Cabecera. ParamByName( 'ID' ) . AsInteger : = ID;
tbl_Compensados. ParamByName( 'ID_RECIBO' ) . AsInteger : = ID;
2007-11-05 17:59:28 +00:00
2008-10-31 18:16:49 +00:00
tbl_Cabecera. Active : = True ;
tbl_Compensados. Active : = True ;
2007-11-05 17:59:28 +00:00
2008-11-27 09:16:29 +00:00
AInforme : = DarRutaFichero( DarRutaInformes, rptInforme, tbl_Cabecera. FieldByName( 'ID_EMPRESA' ) . AsString) ;
if VarIsNull( AInforme) then
2008-12-01 11:42:52 +00:00
raise Exception. Create ( ( 'Error Servidor: _GenerarRecibo, no encuentra informe ' + rptInforme) ) ;
2008-11-27 09:16:29 +00:00
frxReport. LoadFromFile( AInforme, True ) ;
2008-10-31 18:16:49 +00:00
frxReport. PrepareReport( False ) ;
finally
FConnection. RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
end ;
2007-11-05 17:59:28 +00:00
end ;
end .