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, uDABin2DataStreamer, uDAMemDataTable, frxExportPDF, FactuGES_Intf; type TRptAlbaranesCliente = class(TDataModule) DADataCabecera: TDADataSource; DADataDetalles: TDADataSource; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; frxRichObject1: TfrxRichObject; frxBarCodeObject1: TfrxBarCodeObject; frxOLEObject1: TfrxOLEObject; frxCrossObject1: TfrxCrossObject; frxCheckBoxObject1: TfrxCheckBoxObject; frxGradientObject1: TfrxGradientObject; frxChartObject1: TfrxChartObject; frxDBCabecera: TfrxDBDataset; frxDBDetalles: TfrxDBDataset; frxReport: TfrxReport; Bin2DataStreamer: TDABin2DataStreamer; tbl_Etiquetas: TDAMemDataTable; DADataEtiquetas: TDADataSource; frxDBEtiquetas: TfrxDBDataset; frxPDFExport1: TfrxPDFExport; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; FVerLogotipo: Boolean; FVerPrecios: Boolean; FVerTotales: Boolean; //Genera cada uno de los albaranes a imprimir procedure _GenerarAlbaran(const ID: Integer); public function GenerarAlbaran(const ListaID : TIntegerArray; const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary; function GenerarAlbaranEnPDF(const ListaID : TIntegerArray; const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary; function GenerarEtiquetas(const AID : Integer; const AAgencia: Variant; const ARefPedido: Variant; const ANumEtiquetas: Integer; const AEtiquetaIni: Integer): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, uDataModuleServer, schAlbaranesClienteClient_Intf; const rptInfAlbaran = '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 ListaID : TIntegerArray; const VerLogotipo: Boolean = True; const VerPrecios: Boolean= True; const VerTotales: Boolean = True): Binary; var i: Integer; begin Result := Binary.Create; //Inicializamos parametros FVerLogotipo := VerLogotipo; FVerPrecios := VerPrecios; FVerTotales := VerTotales; //Vamos generando todos y cada uno de los presupuestos recibidos for i := 0 to ListaID.Count - 1 do _GenerarAlbaran(ListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); end; function TRptAlbaranesCliente.GenerarAlbaranEnPDF(const ListaID: TIntegerArray; const VerLogotipo: Boolean = True; const VerPrecios: Boolean = True; const VerTotales: Boolean = True): Binary; var i: Integer; begin Result := Binary.Create; //Inicializamos parametros FVerLogotipo := VerLogotipo; FVerPrecios := VerPrecios; FVerTotales := VerTotales; //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) end; procedure TRptAlbaranesCliente._GenerarAlbaran(const ID: 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 := ID; tbl_Detalles.ParamByName('ID_ALBARAN').AsInteger := ID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInfAlbaran, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString, tbl_Cabecera.FieldByName('ID_TIENDA').AsString); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarAlbaran, no encuentra informe' + rptInfAlbaran)); frxReport.LoadFromFile(AInforme, True); frxReport.Variables.Variables['VerLogotipo'] := FVerLogotipo; frxReport.Variables.Variables['VerPrecios'] := FVerPrecios; frxReport.Variables.Variables['VerTotales'] := FVerTotales; frxReport.ReportOptions.Name := 'Albarán de cliente ' + tbl_Cabecera.FieldByName('REFERENCIA').AsString; 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; const AAgencia: Variant; const ARefPedido: Variant; const ANumEtiquetas: Integer; const AEtiquetaIni: Integer): Binary; var AInforme: Variant; begin Result := Binary.Create; FConnection.BeginTransaction; try tbl_Etiquetas.ParamByName('ID_ALBARAN').AsInteger := AID; tbl_Etiquetas.ParamByName('AGENCIA').AsString := AAgencia; tbl_Etiquetas.ParamByName('REF_PEDIDO').AsString := ARefPedido; tbl_Etiquetas.ParamByName('NUM_ETIQUETAS').AsInteger := ANumEtiquetas; tbl_Etiquetas.ParamByName('ETIQUETA_INI').AsInteger := AEtiquetaIni; tbl_Etiquetas.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' + rptInfEtiquetas)); 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; end; end; end.