Tecsitel_FactuGES2/Source/Modulos/Recibos de cliente/Reports/uRptRecibosCliente_Server.pas

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);
    procedure DataModuleDestroy(Sender: TObject);

  private
    FConnection: IDAConnection;
    FIdEmpresa: Integer;
    FFechaInicio: Variant;
    FFechaFin: Variant;
    FFechaVenInicio: Variant;
    FFechaVenFin: Variant;
    FListaIDClientes: TIntegerArray;
    FListaNombresClientes : TStringList;
    FImporteMinimo: Currency;
    FDesglosado : Boolean;

    procedure _GenerarRecibo(const ID : Integer);

    procedure PrepararTablaInforme(ATabla: TDAMemDataTable);
    procedure PrepararTablaResumenInforme(ATabla: IDADataset);
    function _GenerarInforme(const TipoInforme: String): Binary;
    procedure IniciarParametrosInforme;
    procedure RecuperarNombresClientes;

  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,
  uROServer, DataAbstract4_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;

  FListaNombresClientes := TStringList.Create;

  frxDBCabecera.DataSource := DADataCabecera;
  frxDBCabecera.CloseDataSource := False;

  frxDBCompensados.DataSource := DADataCompensados;
  frxDBCompensados.CloseDataSource := False;
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(FListaIDClientes) and (FListaIDClientes.Count > 0) then
    begin
      RecuperarNombresClientes;
      ACadena := FListaNombresClientes.Text;
    end
    else begin
      ACadena := 'Todos los clientes';
      if FDesglosado then
        ACadena := ACadena + ' (desglosados)'
    end;

    ATextos.Add(ACadena);
    ACadena := '';

    frxReport.Variables.Variables['TextoParametros'] := ATextos.Text;
  finally
    FreeAndNil(ATextos);
  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;

procedure TRptRecibosCliente.RecuperarNombresClientes;
var
  AContactosService : IsrvContactos;
  Intf : IInterface;
  AClientID : TGUID;

  ATableNameArray: StringArray;
  ATableRequestInfoArray: TableRequestInfoArray;
  ATableRequestInfo: TableRequestInfoV5;
  AStream: TMemoryStream;
  ADataTable: TDAMemDataTable;
  i: Integer;
  AWhereBuilder : TDAWhereBuilder;
  ACondicion : TDAWhereExpression;
begin
  CreateGUID(AClientID);

  GetClassFactory('srvContactos').CreateInstance(AClientID, Intf);

  if Assigned(Intf) then
  begin
    AContactosService := Intf as IsrvContactos;

    ATableNameArray := StringArray.Create;
    ATableRequestInfoArray := TableRequestInfoArray.Create;
    AWhereBuilder := TDAWhereBuilder.Create;
    try
      ATableNameArray.Add('Clientes');
      ATableRequestInfo := TableRequestInfoV5.Create;

      with ATableRequestInfo do
      begin
        IncludeSchema := True;
        MaxRecords := -1;
        UserFilter := '';

        AWhereBuilder.Clear;
        with AWhereBuilder do
          for i := 0 to FListaIDClientes.Count - 1 do
          begin
            ACondicion := NewBinaryExpression(
                NewBinaryExpression(NewField('', 'ID'), NewConstant(FListaIDClientes[i], datInteger), dboEqual),
                NewBinaryExpression(NewField('', 'ID_EMPRESA'), NewConstant(FIdEmpresa, datInteger), dboEqual),
                dboAnd);

            if not AWhereBuilder.IsEmpty then
              Expression := NewBinaryExpression(Expression, ACondicion, dboOr)
            else
              Expression := ACondicion;
          end;

        WhereClause := AWhereBuilder.ExpressionToXmlNode(AWhereBuilder.Expression);
      end;

      try
        ATableRequestInfoArray.Add(ATableRequestInfo);
        AStream := AContactosService.GetData(ATableNameArray, ATableRequestInfoArray);
        if Assigned(AStream) then
        begin
          ADataTable := TDAMemDataTable.Create(nil);
          try
            ADataTable.Name := 'Clientes';
            ADataTable.LocalDataStreamer := Bin2DataStreamer;
            ADataTable.RemoteFetchEnabled := False;
            Bin2DataStreamer.ReadDataset(AStream, ADataTable, True);

            ADataTable.Open;
            FListaNombresClientes.Clear;
            for i := 0 to ADataTable.RecordCount - 1 do
            begin
              FListaNombresClientes.Add(ADataTable.FieldByName('NOMBRE').AsString);
              ADataTable.Next;
            end;

          finally
            FreeANDNil(ADataTable);
          end;
        end;
      except
        on e: Exception do
          dmServer.EscribirLog(e.Message);
      end;
    finally
      FreeANDNIL(ATableRequestInfoArray);
      FreeANDNIL(ATableNameArray);
      FreeANDNIL(AWhereBuilder);
    end;
  end;
end;

procedure TRptRecibosCliente.DataModuleDestroy(Sender: TObject);
begin
  tbl_Cabecera.Active := False;
  tbl_Compensados.Active := False;

  FreeANDNIL(FListaNombresClientes);
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;
    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<41> POR CLIENTE
    FDesglosado := Desglosado;
    if FDesglosado 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;
    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<41> POR CLIENTE
    FDesglosado := Desglosado;
    if FDesglosado 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);
  IniciarParametrosInforme;

  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.