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; 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; schReport: TDASchema; DataDictionary: TDADataDictionary; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; //Genera cada uno de los albaranes a imprimir procedure GenerarAlbaran(const AID: integer); overload; public function GenerarAlbaran(const AID : String): Binary; overload; function GenerarEtiquetas(const AID : Integer; withRefCliente: Boolean): 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; end; function TRptAlbaranesCliente.GenerarAlbaran(const AID: String): Binary; var ID_Albaranes: TStringList; i: Integer; begin Result := Binary.Create; //FConnection.BeginTransaction; <--- Creo que no va a hacer falta. try ID_Albaranes := TStringList.Create; ID_Albaranes.CommaText := AID; //Vamos generando todos y cada uno de los albaranes recibidos for i := 0 to ID_Albaranes.Count - 1 do GenerarAlbaran(StrToInt(ID_Albaranes.Strings[i])); frxReport.PreviewPages.SaveToStream(Result); finally //FConnection.RollbackTransaction; <--- Creo que no va a hacer falta. end; end; procedure TRptAlbaranesCliente.GenerarAlbaran(const AID: integer); var AStream: TMemoryStream; dsMaster: IDADataset; dsDetail: IDADataset; begin //AStream := TMemoryStream.Create; try {dsMaster := schReport.NewDataset(FConnection, ds_InformeCabecera, ['ID'], [ID]); dsDetail := schReport.NewDataset(FConnection, ds_InformeDetalles, ['ID_ALBARAN'], [ID], 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);} frxDBCabecera.DataSource := DADSCabecera; frxDBDetalles.DataSource := DADSDetalles; 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 AStream.Free; dsMaster := Nil; dsDetail := Nil; 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.