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; type TRptAlbaranesCliente = class(TDataModule) DADSCabecera: TDADataSource; DADSDetalles: TDADataSource; DABINAdapter: TDABINAdapter; 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; schReport: TDASchema; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; //Genera cada uno de los albaranes a imprimir procedure _GenerarAlbaran(const AID: Integer); public function GenerarAlbaran(const AListaID : TIntegerArray): Binary; function GenerarEtiquetas(const AID : Integer; withRefCliente: Boolean): Binary; function GenerarAlbaranEnPDF(const ListaID : TIntegerArray): Binary; end; implementation {$R *.dfm} uses uDataModuleServer, schAlbaranesClienteClient_Intf; const rptInforme = 'InfAlbaranCliente.fr3'; rptInfEtiquetas = 'InfEtiquetasAlbaranCliente.fr3'; { Dataset names for schReport } ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeDetalles = 'Informe_Detalles'; ds_InformeDetallesEtiquetas = 'Informe_Detalles_Etiquetas'; { TRptAlbaranesCliente } procedure TRptAlbaranesCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; frxDBCabecera.DataSource := DADSCabecera; frxDBDetalles.DataSource := DADSDetalles; end; function TRptAlbaranesCliente.GenerarAlbaran(const AListaID : TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; //FConnection.BeginTransaction; <--- Creo que no va a hacer falta. 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 //FConnection.RollbackTransaction; <--- Creo que no va a hacer falta. end; end; function TRptAlbaranesCliente.GenerarAlbaranEnPDF( const ListaID: TIntegerArray): Binary; var i: Integer; begin Result := Binary.Create; //FConnection.BeginTransaction; <--- Creo que no va a hacer falta. 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 //FConnection.RollbackTransaction; <--- Creo que no va a hacer falta. end; end; procedure TRptAlbaranesCliente._GenerarAlbaran(const AID: Integer); begin 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; frxReport.LoadFromFile(DarRutaInformes + rptInforme, True); frxReport.PrepareReport(False); end; function TRptAlbaranesCliente.GenerarEtiquetas(const AID: Integer; withRefCliente: Boolean): Binary; var dsMaster: IDADataset; dsDetail: IDADataset; AStream: TMemoryStream; begin AStream := TMemoryStream.Create; Result := Binary.Create; FConnection.BeginTransaction; try dsMaster := schReport.NewDataset(FConnection, ds_InformeCabecera, ['ID'], [AID]); dsDetail := schReport.NewDataset(FConnection, ds_InformeDetallesEtiquetas, ['ID_ALBARAN'], [AID], False); AStream.Clear; DABINAdapter.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1); DABINAdapter.ReadDataset(AStream, tbl_Cabecera, TRUE, '', TRUE, TRUE); AStream.Clear; DABINAdapter.WriteDataset(AStream, dsDetail, [woRows, woSchema], -1); DABINAdapter.ReadDataset(AStream, tbl_Detalles, TRUE, '', TRUE, TRUE); frxReport.LoadFromFile(DarRutaInformes + rptInfEtiquetas, True); if withRefCliente then frxReport.Variables.Variables['withRefCliente'] := 1 else frxReport.Variables.Variables['withRefCliente'] := 0; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); finally AStream.Free; FConnection.RollbackTransaction; end; end; end.