unit uRptAlbaranesCliente_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, IBCustomDataSet, IBQuery, IBDatabase, uDAMemDataTable, frxExportPDF, FactuGES_Intf, uDABin2DataStreamer; type TRptAlbaranesCliente = class(TDataModule) DADSCabecera: TDADataSource; DADSDetalles: TDADataSource; frxRichObject1: TfrxRichObject; frxBarCodeObject1: TfrxBarCodeObject; frxOLEObject1: TfrxOLEObject; frxCrossObject1: TfrxCrossObject; frxCheckBoxObject1: TfrxCheckBoxObject; frxGradientObject1: TfrxGradientObject; frxChartObject1: TfrxChartObject; frxDBCabecera: TfrxDBDataset; frxDBDetalles: TfrxDBDataset; frxReport: TfrxReport; IBDatabase1: TIBDatabase; IBTransaction1: TIBTransaction; DataSource1: TDataSource; DataSource3: TDataSource; detalles: TIBQuery; cabecera: TIBQuery; cabeceraID: TIntegerField; cabeceraID_EMPRESA: TIntegerField; cabeceraID_CLIENTE: TIntegerField; cabeceraFECHA_ALBARAN: TDateField; cabeceraREFERENCIA: TIBStringField; cabeceraREFERENCIA_CLIENTE: TIBStringField; cabeceraID_PEDIDO: TIntegerField; cabeceraREF_PEDIDO: TIBStringField; cabeceraOBSERVACIONES: TMemoField; cabeceraIMPORTE_TOTAL: TIBBCDField; cabeceraNIF_CIF: TIBStringField; cabeceraNOMBRE: TIBStringField; cabeceraPERSONA_CONTACTO: TIBStringField; cabeceraCALLE: TIBStringField; cabeceraPOBLACION: TIBStringField; cabeceraPROVINCIA: TIBStringField; cabeceraCODIGO_POSTAL: TIBStringField; detallesID: TIntegerField; detallesID_ALBARAN: TIntegerField; detallesPOSICION: TIntegerField; detallesTIPO_DETALLE: TIBStringField; detallesCONCEPTO: TIBStringField; detallesCANTIDAD: TIntegerField; detallesIMPORTE_UNIDAD: TIBBCDField; detallesIMPORTE_TOTAL: TIBBCDField; detallesREFERENCIA: TIBStringField; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; frxPDFExport1: TfrxPDFExport; DABin2DataStreamer1: TDABin2DataStreamer; frxDBInformeListadoAlbaranesGrafComp: TfrxDBDataset; DASInformeListadoAlbaranesGrafComp: TDADataSource; tbl_InformeListadoAlbaranesGrafCompMensual: TDAMemDataTable; tbl_InformeListadoAlbaranesGrafCompTrimestral: TDAMemDataTable; tbl_InformeListadoAlbaranesGrafCompSemestral: TDAMemDataTable; frxDBInformeListadoClientesMayorAlbaranadoResumen: TfrxDBDataset; DADSInformeListadoClientesMayorAlbaranadoResumen: TDADataSource; tbl_InformeListadoClientesMayorAlbaranadoResumen: TDAMemDataTable; frxDBInformeListadoClientesMayorIncidenciasResumen: TfrxDBDataset; DADSInformeListadoClientesMayorIncidenciasResumen: TDADataSource; tbl_InformeListadoClientesMayorIncidenciasResumen: TDAMemDataTable; frxDBInformeListadoClientesMayorOrdenesDevResumen: TfrxDBDataset; DADSInformeListadoClientesMayorOrdenesDevResumen: TDADataSource; tbl_InformeListadoClientesMayorOrdenesDevResumen: TDAMemDataTable; frxDBInformeObjetivos: TfrxDBDataset; DADSInformeObjetivos: TDADataSource; tbl_InformeObjetivosMensual: TDAMemDataTable; tbl_InformeObjetivosTrimestral: TDAMemDataTable; tbl_InformeObjetivosSemestral: TDAMemDataTable; tbl_Etiquetas: TDAMemDataTable; DADSEtiquetas: TDADataSource; frxDBEtiquetas: TfrxDBDataset; schReport: TDASchema; procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); procedure frxReportGetValue(const VarName: string; var Value: Variant); private FConnection: IDAConnection; FVerLogotipo : Boolean; FVerPrecios : Boolean; FVerRefProveedor : Boolean; FVerObservaciones : Boolean; FVerIncidencias : Boolean; FIdEmpresa: Integer; FAno1: Variant; FAno2: Variant; FIntervalo: Variant; FListaIDClientes: TIntegerArray; FListaIDAgentes: TIntegerArray; FListaNombresAgentes : TStringList; FTopN: Integer; FUnAgentePorPagina: Integer; //Genera cada uno de los albaranes a imprimir procedure _GenerarAlbaran(const AID: Integer); //Genera las etiquetas de cada uno de los albaranes a imprimir procedure _GenerarEtiquetasAlbaran(const AID: Integer); procedure PrepararTablaInformeGrafComp(ATabla: TDAMemDataTable); procedure PrepararTablaResumenInformeGrafComp(ATabla: IDADataset); procedure PrepararTablaInformeObjetivos(ATabla: TDAMemDataTable); procedure IniciarParametrosInforme; procedure RecuperarNombresAgentes; public function GenerarEtiquetas(const ListaID: TIntegerArray): Binary; function GenerarAlbaran(const AListaID : TIntegerArray; const VerPrecios: Boolean; const VerRefProveedor: Boolean; const VerObservaciones: Boolean; const VerIncidencias: Boolean): Binary; function GenerarAlbaranEnPDF(const ListaID : TIntegerArray; const VerPrecios: Boolean; const VerRefProveedor: Boolean; const VerObservaciones: Boolean; const VerIncidencias: Boolean): Binary; function GenerarInformeAlbaranesGrafComp(const IdEmpresa: Integer; const Intervalo: Variant; const Ano1: Variant; const Ano2: Variant; const ListaIDClientes: TIntegerArray; const TopN: Integer; const Serie: Variant): Binary; function GenerarInformeObjetivosAgentesAlbaranes(const IdEmpresa: Integer; const Intervalo: Variant; const Ano1: Variant; const Ano2: Variant; const ListaIDAgentes: TIntegerArray; const TopN: Integer; const UnAgentePorPagina: Integer): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, uDataModuleServer, schAlbaranesClienteClient_Intf, srvGestorInformes_Impl, DataAbstract4_Intf, uROServer; const rptInforme = 'InfAlbaranCliente.fr3'; rptInfEtiquetas = 'InfEtiquetasAlbaranCliente.fr3'; rptInformeListadoAlbaranesClienteGrafComp = 'InformeListadoAlbaranesClienteGrafComp.fr3'; rptInformeObjetivosAgentesAlbaranes = 'InformeObjetivosAgentesAlbaranes.fr3'; { Dataset names for schReport } ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeDetalles = 'Informe_Detalles'; { TRptAlbaranesCliente } procedure TRptAlbaranesCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; frxDBCabecera.DataSource := DADSCabecera; frxDBCabecera.CloseDataSource := False; frxDBDetalles.DataSource := DADSDetalles; frxDBDetalles.CloseDataSource := False; FListaNombresAgentes := TStringList.Create; end; procedure TRptAlbaranesCliente.DataModuleDestroy(Sender: TObject); begin tbl_Cabecera.Active := False; tbl_Detalles.Active := False; FreeANDNIL(FListaNombresAgentes); end; procedure TRptAlbaranesCliente.frxReportGetValue(const VarName: string; var Value: Variant); begin if VarName = 'ShowLogotipo' then Value := FVerLogotipo; if VarName = 'VerPrecios' then Value := FVerPrecios; if VarName = 'VerRefProveedor' then Value := FVerREfProveedor; if VarName = 'VerObservaciones' then Value := FVerObservaciones; if VarName = 'VerIncidencias' then Value := FVerIncidencias; end; function TRptAlbaranesCliente.GenerarAlbaran(const AListaID : TIntegerArray; const VerPrecios: Boolean; const VerRefProveedor: Boolean; const VerObservaciones: Boolean; const VerIncidencias: Boolean): Binary; var i: Integer; begin Result := Binary.Create; FVerLogotipo := True; FVerPrecios := VerPrecios; FVerRefProveedor := VerRefProveedor; FVerObservaciones := VerObservaciones; FVerIncidencias := VerIncidencias; try //Vamos generando todos y cada uno de los albaranes recibidos for i := 0 to AListaID.Count - 1 do _GenerarAlbaran(AListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; function TRptAlbaranesCliente.GenerarAlbaranEnPDF(const ListaID : TIntegerArray; const VerPrecios: Boolean; const VerRefProveedor: Boolean; const VerObservaciones: Boolean; const VerIncidencias: Boolean): Binary; var i: Integer; begin Result := Binary.Create; FVerLogotipo := True; FVerPrecios := VerPrecios; FVerRefProveedor := VerRefProveedor; FVerObservaciones := VerObservaciones; FVerIncidencias := VerIncidencias; try //Vamos generando todos y cada uno de los presupuestos recibidos for i := 0 to ListaID.Count - 1 do _GenerarAlbaran(ListaID.Items[i]); frxPDFExport1.Stream := Result; frxReport.Export(frxPDFExport1) finally end; end; procedure TRptAlbaranesCliente._GenerarAlbaran(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_Detalles.Active := False; tbl_Cabecera.ParamByName('ID').AsInteger := AID; tbl_Detalles.ParamByName('ID_ALBARAN').AsInteger := AID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString, tbl_Cabecera.FieldByName('IDIOMA_ISO').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarFactura, 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; procedure TRptAlbaranesCliente._GenerarEtiquetasAlbaran(const AID: Integer); var AInforme: Variant; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Etiquetas.Active := False; tbl_Etiquetas.ParamByName('ID_ALBARAN').AsInteger := AID; tbl_Etiquetas.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInfEtiquetas, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString, tbl_Cabecera.FieldByName('IDIOMA_ISO').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarEtiquetasAlbaran, no encuentra informe ' + rptInfEtiquetas)); frxReport.LoadFromFile(AInforme, True); frxReport.PrepareReport(False); finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; function TRptAlbaranesCliente.GenerarEtiquetas(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 _GenerarEtiquetasAlbaran(ListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; function TRptAlbaranesCliente.GenerarInformeAlbaranesGrafComp( const IdEmpresa: Integer; const Intervalo, Ano1, Ano2: Variant; const ListaIDClientes: TIntegerArray; const TopN: Integer; const Serie: Variant): Binary; var AStream: TMemoryStream; AInforme: Variant; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" AStream := TMemoryStream.Create; try //Inicializamos parametros FIdEmpresa := IdEmpresa; FAno1 := Ano1; FAno2 := Ano2; FIntervalo := Intervalo; FTopN := TopN; if Assigned(FListaIDClientes) then FListaIDClientes.Free; FListaIDClientes := ListaIDClientes; //Preparamos la tabla correspondiente y la abrimos para el informe if (FIntervalo = CTE_MENSUAL) then PrepararTablaInformeGrafComp(tbl_InformeListadoAlbaranesGrafCompMensual) else if (FIntervalo = CTE_TRIMESTRAL) then PrepararTablaInformeGrafComp(tbl_InformeListadoAlbaranesGrafCompTrimestral) else PrepararTablaInformeGrafComp(tbl_InformeListadoAlbaranesGrafCompSemestral); //Se preparan las tablas del listado resumen del informe PrepararTablaResumenInformeGrafComp(tbl_InformeListadoClientesMayorAlbaranadoResumen); PrepararTablaResumenInformeGrafComp(tbl_InformeListadoClientesMayorIncidenciasResumen); PrepararTablaResumenInformeGrafComp(tbl_InformeListadoClientesMayorOrdenesDevResumen); Result := Binary.Create; AInforme := DarRutaFichero(DarRutaInformes, rptInformeListadoAlbaranesClienteGrafComp, IntTostr(FIdEmpresa)); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: GenerarInformeAlbaranesGrafComp, no encuentra informe ' + rptInformeListadoAlbaranesClienteGrafComp)); frxReport.LoadFromFile(AInforme, True); // IniciarParametrosInforme; frxReport.Variables.Variables['Ano1']:= Ano1; frxReport.Variables.Variables['Ano2']:= Ano2; frxReport.Variables.Variables['Serie']:= Serie; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); finally AStream.Free; FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; function TRptAlbaranesCliente.GenerarInformeObjetivosAgentesAlbaranes( const IdEmpresa: Integer; const Intervalo, Ano1, Ano2: Variant; const ListaIDAgentes: TIntegerArray; const TopN: Integer; const UnAgentePorPagina: Integer): Binary; var AStream: TMemoryStream; AInforme: Variant; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" AStream := TMemoryStream.Create; try //Inicializamos parametros FIdEmpresa := IdEmpresa; FAno1 := Ano1; FIntervalo := Intervalo; FUnAgentePorPagina := UnAgentePorPagina; if Assigned(FListaIDAgentes) then FListaIDClientes.Free; FListaIDAgentes := ListaIDAgentes; //Preparamos la tabla correspondiente y la abrimos para el informe if (FIntervalo = CTE_MENSUAL) then PrepararTablaInformeObjetivos(tbl_InformeObjetivosMensual) else if (FIntervalo = CTE_TRIMESTRAL) then PrepararTablaInformeObjetivos(tbl_InformeObjetivosTrimestral) else PrepararTablaInformeObjetivos(tbl_InformeObjetivosSemestral); Result := Binary.Create; AInforme := DarRutaFichero(DarRutaInformes, rptInformeObjetivosAgentesAlbaranes, IntTostr(FIdEmpresa)); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: GenerarInformeObjetivosAgentesAlbaranes, no encuentra informe ' + rptInformeObjetivosAgentesAlbaranes)); frxReport.LoadFromFile(AInforme, True); IniciarParametrosInforme; frxReport.Variables.Variables['UnAgentePorPagina'] := FUnAgentePorPagina; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); finally AStream.Free; FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; procedure TRptAlbaranesCliente.IniciarParametrosInforme; var ATextos : TStringList; ACadena : String; begin ATextos := TStringList.Create; try ACadena := 'Aņo: ' + FAno1; ATextos.Add(ACadena); ACadena := 'Agente: '; if Assigned(FListaIDAgentes) and (FListaIDAgentes.Count > 0) then begin RecuperarNombresAgentes; ACadena := ACadena + FListaNombresAgentes.Text; end else begin ACadena := 'Todos los agentes'; // if FDesglosado then ACadena := ACadena + ' (desglosados)' end; ATextos.Add(ACadena); ACadena := ''; frxReport.Variables.Variables['TextoParametros'] := ATextos.Text; finally FreeAndNil(ATextos); end; end; procedure TRptAlbaranesCliente.PrepararTablaInformeGrafComp( ATabla: TDAMemDataTable); begin if ATabla.Active then ATabla.Active := False; DASInformeListadoAlbaranesGrafComp.DataTable := ATabla; ATabla.ParamByName('ID_EMPRESA1').AsInteger := FIdEmpresa; ATabla.ParamByName('ID_EMPRESA2').AsInteger := FIdEmpresa; ATabla.ParamByName('ANO1').AsVariant := FAno1; ATabla.ParamByName('ANO2').AsVariant := FAno2; ATabla.Active := True; end; procedure TRptAlbaranesCliente.PrepararTablaInformeObjetivos(ATabla: TDAMemDataTable); var Condicion: TDAWhereExpression; i: Integer; begin if ATabla.Active then ATabla.Active := False; // Filtrar el informe por agente if Assigned(FListaIDAgentes) then begin with ATabla.DynamicWhere do begin for i := 0 to FListaIDAgentes.Count - 1 do begin // (ID_AGENTE = ID) Condicion := NewBinaryExpression(NewField('SEN', 'ID_AGENTE'), NewConstant(FListaIDAgentes.Items[i], datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; end; DADSInformeObjetivos.DataTable := ATabla; ATabla.ParamByName('ID_EMPRESA').AsInteger := FIdEmpresa; ATabla.ParamByName('ANO1').AsVariant := FAno1; ATabla.Active := True; end; procedure TRptAlbaranesCliente.PrepararTablaResumenInformeGrafComp(ATabla: IDADataset); begin if ATabla.Active then ATabla.Active := False; ATabla.ParamByName('ID_EMPRESA').AsInteger := FIdEmpresa; ATabla.ParamByName('ANO').AsVariant := FAno1; ATabla.ParamByName('NTOP').AsInteger := FTopN; ATabla.Active := True; end; procedure TRptAlbaranesCliente.RecuperarNombresAgentes; 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('Agentes'); ATableRequestInfo := TableRequestInfoV5.Create; with ATableRequestInfo do begin IncludeSchema := True; MaxRecords := -1; UserFilter := ''; AWhereBuilder.Clear; with AWhereBuilder do for i := 0 to FListaIDAgentes.Count - 1 do begin ACondicion := NewBinaryExpression( NewBinaryExpression(NewField('', 'ID'), NewConstant(FListaIDAgentes[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 := 'Agentes'; ADataTable.LocalDataStreamer := DABin2DataStreamer1; ADataTable.RemoteFetchEnabled := False; DABin2DataStreamer1.ReadDataset(AStream, ADataTable, True); ADataTable.Open; FListaNombresAgentes.Clear; for i := 0 to ADataTable.RecordCount - 1 do begin FListaNombresAgentes.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; end.