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; 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; FTopN: Integer; //Genera cada uno de los albaranes a imprimir procedure _GenerarAlbaran(const AID: Integer); procedure PrepararTablaInformeGrafComp(ATabla: TDAMemDataTable); procedure PrepararTablaResumenInformeGrafComp(ATabla: IDADataset); public function GenerarEtiquetas(const AID : Integer; withRefCliente: Boolean): 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; end; implementation {$R *.dfm} uses uSistemaFunc, uDataModuleServer, schAlbaranesClienteClient_Intf, srvGestorInformes_Impl; const rptInforme = 'InfAlbaranCliente.fr3'; rptInfEtiquetas = 'InfEtiquetasAlbaranCliente.fr3'; rptInformeListadoAlbaranesClienteGrafComp = 'InformeListadoAlbaranesClienteGrafComp.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; end; procedure TRptAlbaranesCliente.DataModuleDestroy(Sender: TObject); begin tbl_Cabecera.Active := False; tbl_Detalles.Active := False; 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); 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; function TRptAlbaranesCliente.GenerarEtiquetas(const AID: Integer; withRefCliente: Boolean): Binary; var AInforme: Variant; begin Result := Binary.Create; 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, rptInfEtiquetas, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: GenerarEtiquetas, no encuentra informe ' + rptInforme)); 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; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" 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; 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.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; end.