AbetoDesign_FactuGES2/Source/Modulos/Contratos de cliente/Reports/uRptContratosCliente_Server.pas

1128 lines
39 KiB
ObjectPascal
Raw Normal View History

unit uRptContratosCliente_Server;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, frxClass, frxDBSet, uDAScriptingProvider,
uDADataTable, uDACDSDataTable, DB, uDAClasses, uDABINAdapter, uROTypes,
uDAInterfaces, uDAMemDataTable, uDADataStreamer, uDABin2DataStreamer,
frxGradient, frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDAEngine,
IBSQL, IBDatabase, IBCustomDataSet, IBQuery, frxExportPDF, FactuGES_Intf;
type
TRptContratosCliente = class(TDataModule)
DADSCabecera: TDADataSource;
DADSDetalles: TDADataSource;
frxBarCodeObject1: TfrxBarCodeObject;
frxOLEObject1: TfrxOLEObject;
frxCrossObject1: TfrxCrossObject;
frxCheckBoxObject1: TfrxCheckBoxObject;
frxGradientObject1: TfrxGradientObject;
frxDBCabecera: TfrxDBDataset;
frxDBDetalles: TfrxDBDataset;
tbl_Cabecera: TDAMemDataTable;
frxReport: TfrxReport;
IBDatabase1: TIBDatabase;
IBTransaction1: TIBTransaction;
DataSource1: TDataSource;
DataSource2: TDataSource;
capitulos: TIBQuery;
DataSource3: TDataSource;
detalles: TIBQuery;
frxDBCapitulos: TfrxDBDataset;
DABin2DataStreamer1: TDABin2DataStreamer;
cabecera: TIBQuery;
DADSCapitulos: TDADataSource;
tbl_Capitulos: TDAMemDataTable;
frxPDFExport1: TfrxPDFExport;
DADSInformeListadoContratos: TDADataSource;
tbl_InformeListadoContratos: TDAMemDataTable;
frxDBInformeListadoContratos: TfrxDBDataset;
frxDBInformeListadoContratosResumen: TfrxDBDataset;
DADSInformeListadoContratosResumen: TDADataSource;
tbl_InformeListadoContratosResumen: TDAMemDataTable;
tbl_Detalles: TDAMemDataTable;
cabeceraID: TIntegerField;
cabeceraID_EMPRESA: TIntegerField;
cabeceraFECHA_CONTRATO: TDateField;
cabeceraREFERENCIA: TIBStringField;
cabeceraOBSERVACIONES: TMemoField;
cabeceraIMPORTE_NETO: TIBBCDField;
cabeceraIMPORTE_PORTE: TIBBCDField;
cabeceraDESCUENTO: TFloatField;
cabeceraIMPORTE_DESCUENTO: TIBBCDField;
cabeceraBASE_IMPONIBLE: TIBBCDField;
cabeceraIVA: TFloatField;
cabeceraID_CLIENTE: TIntegerField;
cabeceraNIF_CIF: TIBStringField;
cabeceraNOMBRE: TIBStringField;
cabeceraIMPORTE_IVA: TIBBCDField;
cabeceraIMPORTE_TOTAL: TIBBCDField;
cabeceraPERSONA_CONTACTO: TIBStringField;
cabeceraCALLE: TIBStringField;
cabeceraPOBLACION: TIBStringField;
cabeceraPROVINCIA: TIBStringField;
cabeceraCODIGO_POSTAL: TIBStringField;
frxDBCondiciones: TfrxDBDataset;
DADSCondiciones: TDADataSource;
tbl_Condiciones: TDAMemDataTable;
frxDBEtiquetas: TfrxDBDataset;
DADataEtiquetas: TDADataSource;
tbl_Etiquetas: TDAMemDataTable;
2025-07-23 10:19:05 +00:00
frxDBInformeVentasArticulos: TfrxDBDataset;
DADSInformeVentasArticulos: TDADataSource;
tbl_informeVentasArticulos: TDAMemDataTable;
frxDBInformeVentasArticulosComercial: TfrxDBDataset;
DADSInformeVentasArticulosComercial: TDADataSource;
tbl_informeVentasArticulosComercial: TDAMemDataTable;
frxDBInformeVentasComercialesResumen: TfrxDBDataset;
DADSInformeVentasComercialesResumen: TDADataSource;
tbl_InformeVentasComercialesResumen: TDAMemDataTable;
frxDBInformeVentasComercialResumen: TfrxDBDataset;
DADSInformeVentasComercialResumen: TDADataSource;
tbl_InformeVentasComercialResumen: TDAMemDataTable;
schReport: TDASchema;
DataDictionary: TDADataDictionary;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
function frxReportUserFunction(const MethodName: string;
var Params: Variant): Variant;
private
FConnection: IDAConnection;
FIdEmpresa: Integer;
FFechaInicio: Variant;
FFechaFin: Variant;
FListaIDClientes: TIntegerArray;
2025-07-23 10:19:05 +00:00
FListaIDComerciales: TIntegerArray;
FListaIDArticulos: TIntegerArray;
FListaNombresClientes: TStringList;
2025-07-23 10:19:05 +00:00
FListaNombresComerciales: TStringList;
FListaNombresArticulos: TStringList;
FImporteMinimo: Currency;
FDesglosado : Boolean;
FVerLogotipo : Boolean;
FNombreEmpresa: String;
FVerPrecios: Boolean;
FVerTotales: Boolean;
procedure _GenerarContrato(const AID : Integer);
2025-07-23 10:19:05 +00:00
procedure PrepararTablaInformeVentasArticulo(ATabla: TDAMemDataTable);
procedure PrepararTablaResumenInformeVentasComerciales(ATabla: IDADataset);
procedure PrepararTablaInforme(ATabla: TDAMemDataTable);
procedure PrepararTablaResumenInforme(ATabla: IDADataset);
function _GenerarInforme(const TipoInforme: String): Binary;
2025-07-23 10:19:05 +00:00
procedure IniciarParametrosInforme(const TipoInforme: String);
procedure RecuperarNombresClientes;
2025-07-23 10:19:05 +00:00
procedure RecuperarNombresConerciales;
procedure RecuperarNombresArticulos;
public
function GenerarContrato(const ListaID : TIntegerArray; const NombreEmpresa: AnsiString;
const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary;
function GenerarContratoEnPDF(const ListaID : TIntegerArray; const NombreEmpresa: AnsiString;
const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary;
function GenerarInformeListadoContratos(const IdEmpresa: Integer; const FechaInicio: Variant; const FechaFin: Variant; const ListaIDClientes: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary;
2025-07-23 10:19:05 +00:00
function GenerarEtiquetas(const AID : Integer; const AAgencia: Variant; const ARefPedido: Variant; const ANumEtiquetas: Integer; const AEtiquetaIni: Integer): Binary;
function GenerarInformeVentasArticulos(const IdEmpresa: Integer; const FechaInicio: Variant; const FechaFin: Variant; const ListaIDArticulos: TIntegerArray; const ListaIDComerciales: TIntegerArray): Binary;
end;
implementation
{$R *.dfm}
uses
uSistemaFunc, StrUtils, uDataModuleServer, schContratosClienteClient_Intf,
2025-07-23 10:19:05 +00:00
uROServer, DataAbstract4_Intf, uBizidiomasServer, uStringsUtils;
const
rptInforme = 'InfContratoCliente.fr3';
rptInformeListadoContratosDesglosado = 'InformeListadoContratosDesglosado.fr3';
rptInformeListadoContratos = 'InformeListadoContratos.fr3';
2025-07-23 10:19:05 +00:00
rptInfEtiquetas = 'InfEtiquetasContratoCliente.fr3';
rptInformeVentasArticulos = 'InformeVentasArticulos.fr3';
rptInformeVentasArticulosComercial = 'InformeVentasArticulosComercial.fr3';
{ Dataset names for schReport }
ds_InformeListadoContratosResumen = 'InformeListadoContratosResumen';
2025-07-23 10:19:05 +00:00
ds_InformeVentasComercialesResumen = 'InformeVentasComercialesResumen';
ds_InformeVentasComercialResumen = 'InformeVentasComercialResumen';
procedure TRptContratosCliente.DataModuleCreate(Sender: TObject);
begin
schReport.ConnectionManager := dmServer.ConnectionManager;
FConnection := dmServer.DarNuevaConexion;
frxReport.EngineOptions.NewSilentMode := simReThrow;
frxDBCabecera.DataSource := DADSCabecera;
frxDBCabecera.CloseDataSource := False;
frxDBCapitulos.DataSource := DADSCapitulos;
frxDBCapitulos.CloseDataSource := False;
frxDBDetalles.DataSource := DADSDetalles;
frxDBDetalles.CloseDataSource := False;
FListaNombresClientes := TStringList.Create;
2025-07-23 10:19:05 +00:00
FListaNombresComerciales := TStringList.Create;
FListaNombresArticulos := TStringList.Create;
with tbl_Detalles do
begin
MasterSource := DADSCapitulos;
MasterFields := 'ID';
DetailFields := 'ID_CAPITULO';
MasterMappingMode := mmWhere;
end;
end;
function TRptContratosCliente.GenerarContratoEnPDF(const ListaID: TIntegerArray; const NombreEmpresa: AnsiString;
const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary;
var
i: Integer;
begin
Result := Binary.Create;
try
//Inicializamos parametros
FVerLogotipo := VerLogotipo;
FNombreEmpresa := NombreEmpresa;
FVerPrecios := VerPrecios;
FVerTotales := VerTotales;
//Vamos generando todos y cada uno de los Contratos recibidos
for i := 0 to ListaID.Count - 1 do
_GenerarContrato(ListaID.Items[i]);
frxPDFExport1.Stream := Result;
frxReport.Export(frxPDFExport1)
finally
end;
end;
function TRptContratosCliente.GenerarEtiquetas(const AID: Integer;
const AAgencia, ARefPedido: Variant; const ANumEtiquetas,
AEtiquetaIni: Integer): Binary;
var
AInforme: Variant;
begin
Result := Binary.Create;
FConnection.BeginTransaction;
try
tbl_Etiquetas.ParamByName('ID_CONTRATO').AsInteger := AID;
tbl_Etiquetas.ParamByName('AGENCIA').AsString := AAgencia;
tbl_Etiquetas.ParamByName('REF_PEDIDO').AsString := ARefPedido;
tbl_Etiquetas.ParamByName('NUM_ETIQUETAS').AsInteger := ANumEtiquetas;
tbl_Etiquetas.ParamByName('ETIQUETA_INI').AsInteger := AEtiquetaIni;
tbl_Etiquetas.Active := True;
AInforme := DarRutaFichero(DarRutaInformes, rptInfEtiquetas, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString);
if VarIsNull(AInforme) then
raise Exception.Create (('Error Servidor: GenerarEtiquetas, no encuentra informe' + rptInfEtiquetas));
frxReport.LoadFromFile(AInforme, True);
// if withRefCliente then
// frxReport.Variables.Variables['withRefCliente'] := 1
// else
// frxReport.Variables.Variables['withRefCliente'] := 0;
frxReport.PrepareReport(False);
frxReport.PreviewPages.SaveToStream(Result);
finally
FConnection.RollbackTransaction;
end;
end;
2025-07-23 10:19:05 +00:00
procedure TRptContratosCliente.IniciarParametrosInforme(const TipoInforme: String);
var
ATextos : TStringList;
ACadena : String;
begin
ATextos := TStringList.Create;
try
if (not VarIsNull(FFechaInicio)) and (not VarIsNull(FFechaFin)) then
ACadena := Format('Fechas de Contrato desde el %s hasta el %s', [VarToStr(FFechaInicio), VarToStr(FFechaFin)])
else
ACadena := 'Sin rango de fechas';
ATextos.Add(ACadena);
ACadena := '';
if (FImporteMinimo > 0) then
begin
ACadena := Format('Contratos 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
2025-07-23 10:19:05 +00:00
if (TipoInforme <> rptInformeVentasArticulos)
and (TipoInforme <> rptInformeVentasArticulosComercial) then
ACadena := 'Todos los clientes';
if FDesglosado then
ACadena := ACadena + ' (desglosados)'
end;
2025-07-23 10:19:05 +00:00
if not EsCadenaVacia(ACadena) then
ATextos.Add(ACadena);
ACadena := '';
if Assigned(FListaIDComerciales) and (FListaIDComerciales.Count > 0) then
begin
RecuperarNombresConerciales;
ACadena := FListaNombresComerciales.Text;
end
else begin
ACadena := 'Todos los comerciales';
if FDesglosado then
ACadena := ACadena + ' (desglosados)'
end;
if not EsCadenaVacia(ACadena) then
ATextos.Add(ACadena);
ACadena := '';
if Assigned(FListaIDArticulos) and (FListaIDArticulos.Count > 0) then
begin
RecuperarNombresArticulos;
ACadena := FListaNombresArticulos.Text;
end
else begin
ACadena := 'Todos los articulos';
if FDesglosado then
ACadena := ACadena + ' (desglosados)'
end;
if not EsCadenaVacia(ACadena) then
ATextos.Add(ACadena);
ACadena := '';
frxReport.Variables.Variables['TextoParametros'] := ATextos.Text;
finally
FreeAndNil(ATextos);
end;
end;
procedure TRptContratosCliente.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_ContratosClienteID_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_ContratosClienteFECHA_Contrato), NewConstant(FFechaInicio, datDateTime), dboGreaterOrEqual);
Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_ContratosClienteFECHA_Contrato), NewConstant(FFechaFin, datDateTime), dboLessOrEqual), Condicion, dboAnd);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
2025-07-23 10:19:05 +00:00
// Filtrar el informe por cliente
if Assigned(FListaIDClientes) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDClientes.Count - 1 do
begin
// (ID_CLIENTE = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosClienteID_CLIENTE), NewConstant(FListaIDClientes.Items[i], datInteger), dboEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
2025-07-23 10:19:05 +00:00
// Filtrar el informe por cliente
if Assigned(FListaIDComerciales) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDComerciales.Count - 1 do
begin
// (ID_CLIENTE = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosClienteID_AGENTE), NewConstant(FListaIDComerciales.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_ContratosClienteIMPORTE_TOTAL), NewConstant(FImporteMinimo, datCurrency), dboGreaterOrEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
2025-07-23 10:19:05 +00:00
procedure TRptContratosCliente.PrepararTablaInformeVentasArticulo(ATabla: TDAMemDataTable);
var
Condicion: TDAWhereExpression;
i: Integer;
begin
// Filtrar el informe por empresa
if not VarIsNull(FIdEmpresa) then
begin
ATabla.ParamByName('ID_EMPRESA').AsVariant := FIdEmpresa;
end;
// Filtrar el informe por fechas
if not VarIsNull(FFechaInicio)
and not VarIsNull(FFechaFin) then
begin
ATabla.ParamByName('FECHAINI').AsVariant := FFechaInicio;
ATabla.ParamByName('FECHAFIN').AsVariant := FFechaFin;
end;
// Filtrar el informe por Comerciales
if Assigned(FListaIDComerciales) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDComerciales.Count - 1 do
begin
// (ID_AGENTE = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosClienteID_AGENTE), NewConstant(FListaIDComerciales.Items[i], datInteger), dboEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
// Filtrar el informe por articulo
if Assigned(FListaIDArticulos) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDArticulos.Count - 1 do
begin
// (ID_ARTICULO = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosCliente_DetallesID_ARTICULO), NewConstant(FListaIDArticulos.Items[i], datInteger), dboEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
2025-07-23 10:19:05 +00:00
end;
procedure TRptContratosCliente.PrepararTablaResumenInforme(ATabla: IDADataset);
var
i: Integer;
AWhereStr : String;
begin
// Filtrar el informe por empresa
AWhereStr := ' (' + fld_ContratosClienteID_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_ContratosClienteFECHA_Contrato + ' between ''' + ReplaceStr(VarToStr(FFechaInicio),'/','.') + ''' and ''' + ReplaceStr(VarToStr(FFechaFin),'/','.') + ''') ';
end;
// Filtrar el informe por cliente
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_ContratosClienteID_CLIENTE + ' = ' + IntToStr(FListaIDClientes.Items[i]) + ') ';
end;
end;
2025-07-23 10:19:05 +00:00
// Filtrar el informe por articulo
if Assigned(FListaIDArticulos) then
begin
{ for i := 0 to FListaIDArticulos.Count - 1 do
begin
if Length(AWhereStr) > 0 then
AWhereStr := AWhereStr + 'AND';
AWhereStr := AWhereStr + ' (' + fld_ContratosClienteID_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_ContratosClienteIMPORTE_TOTAL + ' >= ' + CurrToStr(FImporteMinimo) + ') ';
end;
ATabla.Where.AddText(AWhereStr);
end;
2025-07-23 10:19:05 +00:00
procedure TRptContratosCliente.PrepararTablaResumenInformeVentasComerciales(ATabla: IDADataset);
var
i: Integer;
AWhereStr : String;
Condicion: TDAWhereExpression;
begin
// Filtrar el informe por empresa
with ATabla.DynamicWhere do
begin
// (ID_EMPRESA >= ID)
Condicion := NewBinaryExpression(NewField('', ('FC.'+ fld_ContratosClienteID_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_ContratosClienteFECHA_Contrato), NewConstant(FFechaInicio, datDateTime), dboGreaterOrEqual);
Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_ContratosClienteFECHA_Contrato), NewConstant(FFechaFin, datDateTime), dboLessOrEqual), Condicion, dboAnd);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
// Filtrar el informe por Comerciales
if Assigned(FListaIDComerciales) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDComerciales.Count - 1 do
begin
// (ID_AGENTE = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosClienteID_AGENTE), NewConstant(FListaIDComerciales.Items[i], datInteger), dboEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
// Filtrar el informe por articulo
if Assigned(FListaIDArticulos) then
begin
with ATabla.DynamicWhere do
begin
for i := 0 to FListaIDArticulos.Count - 1 do
begin
// (ID_ARTICULO = ID)
Condicion := NewBinaryExpression(NewField('', fld_ContratosCliente_DetallesID_ARTICULO), NewConstant(FListaIDArticulos.Items[i], datInteger), dboEqual);
if IsEmpty then
Expression := Condicion
else
Expression := NewBinaryExpression(Expression, Condicion, dboAnd);
end;
end;
end;
end;
procedure TRptContratosCliente.RecuperarNombresArticulos;
var
AArticulosService : IsrvArticulos;
Intf : IInterface;
AClientID : TGUID;
ATableNameArray: StringArray;
ATableRequestInfoArray: TableRequestInfoArray;
ATableRequestInfo: TableRequestInfoV5;
AStream: TMemoryStream;
ADataTable: TDAMemDataTable;
i: Integer;
AWhereBuilder : TDAWhereBuilder;
ACondicion : TDAWhereExpression;
ACadena: String;
begin
CreateGUID(AClientID);
GetClassFactory('srvArticulos').CreateInstance(AClientID, Intf);
if Assigned(Intf) then
begin
AArticulosService := Intf as IsrvArticulos;
ATableNameArray := StringArray.Create;
ATableRequestInfoArray := TableRequestInfoArray.Create;
AWhereBuilder := TDAWhereBuilder.Create;
try
ATableNameArray.Add('Articulos');
ATableRequestInfo := TableRequestInfoV5.Create;
with ATableRequestInfo do
begin
IncludeSchema := True;
MaxRecords := -1;
UserFilter := '';
AWhereBuilder.Clear;
with AWhereBuilder do
for i := 0 to FListaIDArticulos.Count - 1 do
begin
ACondicion := NewBinaryExpression(
NewBinaryExpression(NewField('', 'ID'), NewConstant(FListaIDArticulos[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 := AArticulosService.GetData(ATableNameArray, ATableRequestInfoArray);
if Assigned(AStream) then
begin
ADataTable := TDAMemDataTable.Create(nil);
try
ADataTable.Name := 'Articulos';
ADataTable.LocalDataStreamer := DABin2DataStreamer1;
ADataTable.RemoteFetchEnabled := False;
DABin2DataStreamer1.ReadDataset(AStream, ADataTable, True);
ADataTable.Open;
FListaNombresArticulos.Clear;
for i := 0 to ADataTable.RecordCount - 1 do
begin
ACadena := ADataTable.FieldByName('FAMILIA').AsString + ADataTable.FieldByName('REFERENCIA_PROV').AsString + ADataTable.FieldByName('DESCRIPCION').AsString;
FListaNombresArticulos.Add(ACadena);
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 TRptContratosCliente.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 := DABin2DataStreamer1;
ADataTable.RemoteFetchEnabled := False;
DABin2DataStreamer1.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;
2025-07-23 10:19:05 +00:00
procedure TRptContratosCliente.RecuperarNombresConerciales;
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('Comerciales');
ATableRequestInfo := TableRequestInfoV5.Create;
with ATableRequestInfo do
begin
IncludeSchema := True;
MaxRecords := -1;
UserFilter := '';
AWhereBuilder.Clear;
with AWhereBuilder do
for i := 0 to FListaIDComerciales.Count - 1 do
begin
ACondicion := NewBinaryExpression(
NewBinaryExpression(NewField('', 'ID'), NewConstant(FListaIDComerciales[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 := 'Comerciales';
ADataTable.LocalDataStreamer := DABin2DataStreamer1;
ADataTable.RemoteFetchEnabled := False;
DABin2DataStreamer1.ReadDataset(AStream, ADataTable, True);
ADataTable.Open;
FListaNombresComerciales.Clear;
for i := 0 to ADataTable.RecordCount - 1 do
begin
FListaNombresComerciales.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 TRptContratosCliente.DataModuleDestroy(Sender: TObject);
begin
tbl_Cabecera.Active := False;
tbl_Capitulos.Active := False;
tbl_Detalles.Active := False;
tbl_Condiciones.Active := False;
FreeANDNIL(FListaNombresClientes);
2025-07-23 10:19:05 +00:00
FreeANDNIL(FListaNombresComerciales);
FreeANDNIL(FListaNombresArticulos);
end;
function TRptContratosCliente.frxReportUserFunction(const MethodName: string;
var Params: Variant): Variant;
var
AText : String;
begin
Result := '';
if (MethodName = 'PONERJUSTIFICACIONCOMPLETA') then
begin
AText := VarToStr(Params[0]);
Result := ReplaceStr(AText, '\pard', '\qj');
end;
end;
function TRptContratosCliente.GenerarInformeListadoContratos(
const IdEmpresa: Integer; const FechaInicio, FechaFin: 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;
FImporteMinimo := ImporteMinimo;
if Assigned(FListaIDClientes) then
FListaIDClientes.Free;
FListaIDClientes := ListaIDClientes;
if tbl_InformeListadoContratos.Active then
tbl_InformeListadoContratos.Active := False;
PrepararTablaInforme(tbl_InformeListadoContratos);
//Se prepara la tabla del listado resumen del informe
if tbl_InformeListadoContratosResumen.Active then
tbl_InformeListadoContratosResumen.Active := False;
dsMaster := schReport.NewDataset(FConnection, ds_InformeListadoContratosResumen, [], [], False);
PrepararTablaResumenInforme(dsMaster);
//Esto se hace para rellenar la tabla del datamodule que usa el informe.
dsMaster.Open;
AStream.Clear;
DABin2DataStreamer1.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1);
DABin2DataStreamer1.ReadDataset(AStream, tbl_InformeListadoContratosResumen, TRUE, '', TRUE, TRUE);
//DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSAR<41> POR CLIENTE
FDesglosado := Desglosado;
if FDesglosado then
ATipoInforme := rptInformeListadoContratosDesglosado
else
ATipoInforme := rptInformeListadoContratos;
//Finalmente se abren las tablas del informe
tbl_InformeListadoContratos.Active := True;
tbl_InformeListadoContratosResumen.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;
2025-07-23 10:19:05 +00:00
function TRptContratosCliente.GenerarInformeVentasArticulos(const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const ListaIDArticulos: TIntegerArray; const ListaIDComerciales: TIntegerArray): 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;
if Assigned(FListaIDArticulos) then
FListaIDArticulos.Free;
FListaIDArticulos := ListaIDArticulos;
if Assigned(FListaIDComerciales) then
FListaIDComerciales.Free;
FListaIDComerciales := ListaIDComerciales;
if Assigned(FListaIDComerciales) and (FListaIDComerciales.Count > 0) then
begin
if tbl_InformeVentasArticulosComercial.Active then
tbl_InformeVentasArticulosComercial.Active := False;
PrepararTablaInformeVentasArticulo(tbl_InformeVentasArticulosComercial);
ATipoInforme := rptInformeVentasArticulosComercial;
tbl_InformeVentasArticulosComercial.Active := True;
//Se prepara la tabla del listado resumen del informe
if tbl_InformeVentasComercialResumen.Active then
tbl_InformeVentasComercialResumen.Active := False;
dsMaster := schReport.NewDataset(FConnection, ds_InformeVentasComercialResumen, [], [], False);
PrepararTablaResumenInformeVentasComerciales(dsMaster);
//Esto se hace para rellenar la tabla del datamodule que usa el informe.
dsMaster.Open;
AStream.Clear;
DABin2DataStreamer1.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1);
DABin2DataStreamer1.ReadDataset(AStream, tbl_InformeVentasComercialResumen, TRUE, '', TRUE, TRUE);
//Finalmente se abren las tablas del informe
tbl_InformeVentasComercialResumen.Active := True;
end
else
begin
if tbl_InformeVentasArticulos.Active then
tbl_InformeVentasArticulos.Active := False;
PrepararTablaInformeVentasArticulo(tbl_InformeVentasArticulos);
ATipoInforme := rptInformeVentasArticulos;
tbl_InformeVentasArticulos.Active := True;
//Se prepara la tabla del listado resumen del informe
if tbl_InformeVentasComercialesResumen.Active then
tbl_InformeVentasComercialesResumen.Active := False;
dsMaster := schReport.NewDataset(FConnection, ds_InformeVentasComercialesResumen, [], [], False);
PrepararTablaResumenInformeVentasComerciales(dsMaster);
//Esto se hace para rellenar la tabla del datamodule que usa el informe.
dsMaster.Open;
AStream.Clear;
DABin2DataStreamer1.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1);
DABin2DataStreamer1.ReadDataset(AStream, tbl_InformeVentasComercialesResumen, TRUE, '', TRUE, TRUE);
//Finalmente se abren las tablas del informe
tbl_InformeVentasComercialesResumen.Active := True;
end;
//Se prepara la tabla del listado resumen del informe
{ if tbl_InformeListadoContratosResumen.Active then
tbl_InformeListadoContratosResumen.Active := False;
dsMaster := schReport.NewDataset(FConnection, ds_InformeListadoContratosResumen, [], [], False);
PrepararTablaResumenInforme(dsMaster);
}
//Esto se hace para rellenar la tabla del datamodule que usa el informe.
{ dsMaster.Open;
AStream.Clear;
DABin2DataStreamer1.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1);
DABin2DataStreamer1.ReadDataset(AStream, tbl_InformeListadoContratosResumen, TRUE, '', TRUE, TRUE);
}
//DESGLOSADO POR CLIENTE EN ESTE INFORME NO SE DESGLOSAR<41> POR CLIENTE
{ FDesglosado := Desglosado;
if FDesglosado then
ATipoInforme := rptInformeListadoContratosDesglosado
else
ATipoInforme := rptInformeListadoContratos;
}
//Finalmente se abren las tablas del informe
// tbl_InformeListadoContratosResumen.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 TRptContratosCliente.GenerarContrato(const ListaID: TIntegerArray; const NombreEmpresa: AnsiString;
const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary;
var
i: Integer;
begin
Result := Binary.Create;
try
//Inicializamos parametros
FVerLogotipo := VerLogotipo;
FNombreEmpresa := NombreEmpresa;
FVerPrecios := VerPrecios;
FVerTotales := VerTotales;
//Vamos generando todos y cada uno de los Contratos recibidos
for i := 0 to ListaID.Count - 1 do
_GenerarContrato(ListaID.Items[i]);
frxReport.PreviewPages.SaveToStream(Result);
finally
end;
end;
function TRptContratosCliente._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);
2025-07-23 10:19:05 +00:00
IniciarParametrosInforme(TipoInforme);
frxReport.PrepareReport(False);
frxReport.PreviewPages.SaveToStream(Result);
end;
procedure TRptContratosCliente._GenerarContrato(const AID: Integer);
var
AInforme: Variant;
begin
FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
try
tbl_Cabecera.Active := False;
tbl_Capitulos.Active := False;
tbl_Detalles.Active := False;
tbl_Condiciones.Active := False;
tbl_Cabecera.ParamByName('ID').AsInteger := AID;
tbl_Capitulos.ParamByName('ID_PRE_CON').AsInteger := AID;
tbl_Detalles.ParamByName('ID_PRE_CON').AsInteger := AID;
// Se asignan los parametros en este orden para que funcionen
// dentro de las relaciones maestro-detalle (cap<61>tulos y conceptos).
tbl_Cabecera.Active := True;
tbl_Capitulos.Active := True;
tbl_Detalles.Active := True;
tbl_Condiciones.Active := True;
if (tbl_Cabecera.FieldByName('IDIOMA_ISO').AsString = IDIOMA_EN) then
AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString, tbl_Cabecera.FieldByName('ID_TIENDA').AsString, IDIOMA_EN)
2025-07-23 10:19:05 +00:00
else if (tbl_Cabecera.FieldByName('IDIOMA_ISO').AsString = IDIOMA_FR) then
AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString, tbl_Cabecera.FieldByName('ID_TIENDA').AsString, IDIOMA_FR)
else
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: _GenerarContrato, no encuentra informe ' + rptInforme));
frxReport.LoadFromFile(AInforme, True);
frxReport.Variables.Variables['VerLogotipo'] := FVerLogotipo;
frxReport.Variables.Variables['NombreEmpresa'] := ''''+FNombreEmpresa+'''';
frxReport.Variables.Variables['VerPrecios'] := FVerPrecios;
frxReport.Variables.Variables['VerTotales'] := FVerTotales;
frxReport.AddFunction('function PONERJUSTIFICACIONCOMPLETA(ARTFText : String): String', 'User Function','');
frxReport.ReportOptions.Name := 'Pedido ' + 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.