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; 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): 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 _GenerarAlbaran(ListaID.Items[i]); frxPDFExport1.Stream := Result; frxReport.Export(frxPDFExport1) finally end; end; procedure TRptAlbaranesCliente._GenerarAlbaran(const AID: Integer); 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; frxReport.LoadFromFile(DarRutaInformes + rptInforme, 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 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.