unit uRptPedidosCliente_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, uROClient; type TRptPedidosCliente = 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; frxDBEtiquetas: TfrxDBDataset; DADSEtiquetas: TDADataSource; tbl_Etiquetas: TDAMemDataTable; schReport: TDASchema; procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); private FConnection: IDAConnection; //Genera cada uno de los pedidos a imprimir procedure _GenerarPedido(const AID: Integer); public function GenerarPedido(const AListaID : TIntegerArray): Binary; function GenerarEtiquetas(const AListaID : TIntegerArray; const AMercancia: Variant; const ABultos: Integer): Binary; function GenerarPedidoEnPDF(const ListaID : TIntegerArray): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, uDataModuleServer, schPedidosClienteClient_Intf; const rptInforme = 'InfPedidoCliente.fr3'; rptInfEtiquetas = 'InfEtiquetasPedidoCliente.fr3'; { Dataset names for schReport } ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeDetalles = 'Informe_Detalles'; ds_InformeDetallesEtiquetas = 'Informe_Detalles_Etiquetas'; { TRptPedidosCliente } procedure TRptPedidosCliente.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 TRptPedidosCliente.DataModuleDestroy(Sender: TObject); begin tbl_Cabecera.Active := False; tbl_Detalles.Active := False; end; function TRptPedidosCliente.GenerarPedido(const AListaID : TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los pedidos recibidos for i := 0 to AListaID.Count - 1 do _GenerarPedido(AListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; function TRptPedidosCliente.GenerarPedidoEnPDF( const ListaID: TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los presupuestos recibidos for i := 0 to ListaID.Count - 1 do _GenerarPedido(ListaID.Items[i]); frxPDFExport1.Stream := Result; frxReport.Export(frxPDFExport1) finally end; end; procedure TRptPedidosCliente._GenerarPedido(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_PEDIDO').AsInteger := AID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInforme); //, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString); pedidos comunes a todas las empresas if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarPedido, 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 TRptPedidosCliente.GenerarEtiquetas(const AListaID : TIntegerArray; const AMercancia: Variant; const ABultos: Integer): Binary; var i: Integer; AInforme: Variant; Cadena : String; begin Result := Binary.Create; try //Vamos generando todos y cada uno de los pedidos recibidos for i := 0 to AListaID.Count - 1 do begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Etiquetas.Active := False; tbl_Etiquetas.ParamByName('ID').AsInteger := AListaID.Items[i]; tbl_Etiquetas.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInfEtiquetas); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: GenerarEtiquetas, no encuentra informe ' + rptInfEtiquetas)); frxReport.LoadFromFile(AInforme, True); frxReport.Variables.Variables['Mercancia'] := '''' + AMercancia + ''''; frxReport.Variables.Variables['Bultos'] := ABultos; frxReport.PrepareReport(False); finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; frxReport.PreviewPages.SaveToStream(Result); finally end; end; end.