unit uRptPedidosProveedor_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; type TRptPedidosProveedor = class(TDataModule) frxDBCabecera: TfrxDBDataset; frxDBDetalles: TfrxDBDataset; frxReport: TfrxReport; IBDatabase1: TIBDatabase; IBTransaction1: TIBTransaction; DataSource1: TDataSource; DataSource2: TDataSource; cabecera: TIBQuery; detalles: TIBQuery; frxCheckBoxObject1: TfrxCheckBoxObject; frxChartObject1: TfrxChartObject; frxGradientObject1: TfrxGradientObject; frxCrossObject1: TfrxCrossObject; frxOLEObject1: TfrxOLEObject; frxBarCodeObject1: TfrxBarCodeObject; frxRichObject1: TfrxRichObject; DADSCabecera: TDADataSource; DADSDetalles: TDADataSource; tbl_Detalles: TDAMemDataTable; tbl_Cabecera: TDAMemDataTable; detallesID: TIntegerField; detallesID_PEDIDO: TIntegerField; detallesPOSICION: TIntegerField; detallesTIPO_DETALLE: TIBStringField; detallesREFERENCIA: TIBStringField; detallesCONCEPTO: TIBStringField; detallesCANTIDAD: TIntegerField; detallesUNIDAD_MEDIDA: TIBStringField; detallesIMPORTE_UNIDAD: TIBBCDField; detallesIMPORTE_TOTAL: TIBBCDField; detallesREFERENCIA_PROVEEDOR: TIBStringField; detallesREFERENCIA_FABRICANTE: TIBStringField; cabeceraID: TIntegerField; cabeceraID_EMPRESA: TIntegerField; cabeceraREFERENCIA: TIBStringField; cabeceraFECHA_PEDIDO: TDateField; cabeceraOBSERVACIONES: TMemoField; cabeceraNOMBRE: TIBStringField; cabeceraFAX: TIBStringField; cabeceraPERSONA_CONTACTO: TIBStringField; cabeceraCODIGO_CLIENTE: TIBStringField; cabeceraCALLE: TIBStringField; cabeceraPOBLACION: TIBStringField; cabeceraPROVINCIA: TIBStringField; cabeceraCODIGO_POSTAL: TIBStringField; cabeceraENTREGAR_A: TIBStringField; frxPDFExport1: TfrxPDFExport; frxDBInformeListadoPedidos: TfrxDBDataset; DADSInformeListadoPedidos: TDADataSource; tbl_InformeListadoPedidos: TDAMemDataTable; frxDBInformeListadoPedidosResumen: TfrxDBDataset; DADSInformeListadoPedidosResumen: TDADataSource; tbl_InformeListadoPedidosResumen: TDAMemDataTable; DABin2DataStreamer1: TDABin2DataStreamer; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); procedure frxReportGetValue(const VarName: string; var Value: Variant); procedure DataModuleDestroy(Sender: TObject); private FConnection: IDAConnection; FIdEmpresa: Integer; FFechaInicio: Variant; FFechaFin: Variant; FListaIDProveedores: TIntegerArray; FListaNombresProveedores: TStringList; FImporteMinimo: Currency; FImprimirPrecio : Boolean; FImprimirRefProveedor : Boolean; FDesglosado : Boolean; procedure _GenerarPedido(const ID : Integer); procedure RecuperarNombresProveedores; procedure IniciarParametrosInforme; procedure PrepararTablaInforme(ATabla: TDAMemDataTable); procedure PrepararTablaResumenInforme(ATabla: IDADataset); function _GenerarInforme(const TipoInforme: String): Binary; public function GenerarPedido(const ListaID : TIntegerArray; const ImprimirPrecio: Boolean = True; const ImprimirRefProveedor: Boolean = True): Binary; function GenerarPedidoEnPDF(const ListaID: TIntegerArray; const ImprimirPrecio: Boolean = True; const ImprimirRefProveedor: Boolean = True): Binary; function GenerarInformeListadoPedidos(const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const ListaIDProveedores: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; end; implementation {$R *.dfm} uses uSistemaFunc, StrUtils, uDataModuleServer, schPedidosProveedorClient_Intf, uROServer, DataAbstract4_Intf; const rptInforme = 'InfPedidoProveedor.fr3'; rptInformeListadoPedidosDesglosado = 'InformeListadoPedidosDesglosado.fr3'; rptInformeListadoPedidos = 'InformeListadoPedidos.fr3'; { Dataset names for schReport } ds_InformeListadoPedidosResumen = 'InformeListadoPedidosResumen'; ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeDetalles = 'Informe_Detalles'; { TRptPedidosProveedor } procedure TRptPedidosProveedor.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; frxReport.EngineOptions.NewSilentMode := simReThrow; FListaNombresProveedores := TStringList.Create; frxDBCabecera.DataSource := DADSCabecera; frxDBCabecera.CloseDataSource := False; frxDBDetalles.DataSource := DADSDetalles; frxDBDetalles.CloseDataSource := False; end; procedure TRptPedidosProveedor.DataModuleDestroy(Sender: TObject); begin tbl_Cabecera.Active := False; tbl_Detalles.Active := False; FreeANDNIL(FListaNombresProveedores); end; procedure TRptPedidosProveedor.frxReportGetValue(const VarName: string; var Value: Variant); begin if VarName = 'ImprimirPrecio' then Value := FImprimirPrecio; if VarName = 'ImprimirRefProveedor' then Value := FImprimirRefProveedor; end; function TRptPedidosProveedor.GenerarInformeListadoPedidos( const IdEmpresa: Integer; const FechaInicio, FechaFin: Variant; const ListaIDProveedores: TIntegerArray; const Desglosado: Boolean; const ImporteMinimo: Currency): Binary; var ATipoInforme: String; AStream: TMemoryStream; dsMaster: IDADataset; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" AStream := TMemoryStream.Create; try //Inicializamos parametros FIdEmpresa := IdEmpresa; FFechaInicio := FechaInicio; FFechaFin := FechaFin; FImporteMinimo := ImporteMinimo; FListaIDProveedores := ListaIDProveedores; if tbl_InformeListadoPedidos.Active then tbl_InformeListadoPedidos.Active := False; PrepararTablaInforme(tbl_InformeListadoPedidos); //Se prepara la tabla del listado resumen del informe if tbl_InformeListadoPedidosResumen.Active then tbl_InformeListadoPedidosResumen.Active := False; dsMaster := schReport.NewDataset(FConnection, ds_InformeListadoPedidosResumen, [], [], False); PrepararTablaResumenInforme(dsMaster); //Esto se hace para rellenar la tabla del datamodule que usa el informe. dsMaster.Open; AStream.Clear; DABin2DataStreamer1.WriteDataset(AStream, dsMaster, [woRows, woSchema], -1); DABin2DataStreamer1.ReadDataset(AStream, tbl_InformeListadoPedidosResumen, TRUE, '', TRUE, TRUE); //DESGLOSADO POR PROVEEDOR EN ESTE INFORME NO SE DESGLOSARÁ POR PROVEEDOR FDesglosado := Desglosado; if Desglosado then ATipoInforme := rptInformeListadoPedidosDesglosado else ATipoInforme := rptInformeListadoPedidos; //Finalmente se abren las tablas del informe tbl_InformeListadoPedidos.Active := True; tbl_InformeListadoPedidosResumen.Active := True; Result := _GenerarInforme(ATipoInforme); finally AStream.Free; dsMaster := Nil; FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; function TRptPedidosProveedor.GenerarPedido(const ListaID : TIntegerArray; const ImprimirPrecio: Boolean = True; const ImprimirRefProveedor: Boolean = True): Binary; var i: Integer; begin Result := Binary.Create; FImprimirPrecio := ImprimirPrecio; FImprimirRefProveedor := ImprimirRefProveedor; try //Vamos generando todos y cada uno de los pedidos recibidos for i := 0 to ListaID.Count - 1 do _GenerarPedido(ListaID.Items[i]); frxReport.PreviewPages.SaveToStream(Result); finally end; end; function TRptPedidosProveedor._GenerarInforme(const TipoInforme: String): Binary; var AInforme: Variant; begin Result := Binary.Create; AInforme := DarRutaFichero(DarRutaInformes, TipoInforme, IntToStr(FIdEmpresa)); if VarIsNull(AInforme) then raise Exception.Create (('Error Servidor: _GenerarInforme, no encuentra informe ' + TipoInforme)); frxReport.LoadFromFile(AInforme, True); IniciarParametrosInforme; frxReport.PrepareReport(False); frxReport.PreviewPages.SaveToStream(Result); end; procedure TRptPedidosProveedor._GenerarPedido(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_PEDIDO').AsInteger := ID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; AInforme := DarRutaFichero(DarRutaInformes, rptInforme, tbl_Cabecera.FieldByName('ID_EMPRESA').AsString); 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 TRptPedidosProveedor.GenerarPedidoEnPDF( const ListaID: TIntegerArray; const ImprimirPrecio: Boolean; const ImprimirRefProveedor: Boolean): Binary; var i: Integer; begin Result := Binary.Create; FImprimirPrecio := ImprimirPrecio; FImprimirRefProveedor := ImprimirRefProveedor; try //Vamos generando todos y cada uno de los albaranes recibidos for i := 0 to ListaID.Count - 1 do _GenerarPedido(ListaID.Items[i]); frxPDFExport1.Stream := Result; frxReport.Export(frxPDFExport1) finally end; end; procedure TRptPedidosProveedor.IniciarParametrosInforme; var ATextos : TStringList; ACadena : String; begin ATextos := TStringList.Create; try if (not VarIsNull(FFechaInicio)) and (not VarIsNull(FFechaFin)) then ACadena := Format('Fechas de pedido desde el %s hasta el %s', [VarToStr(FFechaInicio), VarToStr(FFechaFin)]) else ACadena := 'Sin rango de fechas'; ATextos.Add(ACadena); ACadena := ''; if (FImporteMinimo > 0) then begin ACadena := Format('Pedidos con importe superior a %m', [FImporteMinimo]); ATextos.Add(ACadena); ACadena := ''; end; if Assigned(FListaIDProveedores) and (FListaIDProveedores.Count > 0) then begin RecuperarNombresProveedores; ACadena := FListaNombresProveedores.Text; end else begin ACadena := 'Todos los proveedores'; if FDesglosado then ACadena := ACadena + ' (desglosados)' end; ATextos.Add(ACadena); ACadena := ''; frxReport.Variables.Variables['TextoParametros'] := ATextos.Text; finally FreeAndNil(ATextos); end; end; procedure TRptPedidosProveedor.PrepararTablaInforme(ATabla: TDAMemDataTable); var Condicion: TDAWhereExpression; i: Integer; begin // Filtrar el informe por empresa with ATabla.DynamicWhere do begin // (ID_EMPRESA >= ID) Condicion := NewBinaryExpression(NewField('', fld_PedidosProveedorID_EMPRESA), NewConstant(FIdEmpresa, datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; // Filtrar el informe por fechas if not VarIsNull(FFechaInicio) and not VarIsNull(FFechaFin) then begin with ATabla.DynamicWhere do begin // (FECHA_INICIO between FECHA_FIN) Condicion := NewBinaryExpression(NewField('', fld_PedidosProveedorFECHA_PEDIDO), NewConstant(FFechaInicio, datDateTime), dboGreaterOrEqual); Condicion := NewBinaryExpression(NewBinaryExpression(NewField('', fld_PedidosProveedorFECHA_PEDIDO), NewConstant(FFechaFin, datDateTime), dboLessOrEqual), Condicion, dboAnd); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; // Filtrar el informe por proveedor if Assigned(FListaIDProveedores) then begin with ATabla.DynamicWhere do begin for i := 0 to FListaIDProveedores.Count - 1 do begin // (ID_PROVEEDOR = ID) Condicion := NewBinaryExpression(NewField('', fld_PedidosProveedorID_PROVEEDOR), NewConstant(FListaIDProveedores.Items[i], datInteger), dboEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; end; // Filtrar el informe por importe minimo if (FImporteMinimo > 0) then begin with ATabla.DynamicWhere do begin // (IMPORTE_TOTAL > ImporteMinimo) Condicion := NewBinaryExpression(NewField('', fld_PedidosProveedorIMPORTE_TOTAL), NewConstant(FImporteMinimo, datCurrency), dboGreaterOrEqual); if IsEmpty then Expression := Condicion else Expression := NewBinaryExpression(Expression, Condicion, dboAnd); end; end; end; procedure TRptPedidosProveedor.PrepararTablaResumenInforme(ATabla: IDADataset); var i: Integer; AWhereStr : String; begin // Filtrar el informe por empresa AWhereStr := ' (' + fld_PedidosProveedorID_EMPRESA + ' = ' + IntToStr(FIdEmpresa) + ') '; // Filtrar el informe por fechas if not VarIsNull(FFechaInicio) and not VarIsNull(FFechaFin) then begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_PedidosProveedorFECHA_PEDIDO + ' between ''' + ReplaceStr(VarToStr(FFechaInicio),'/','.') + ''' and ''' + ReplaceStr(VarToStr(FFechaFin),'/','.') + ''') '; end; // Filtrar el informe por proveedor if Assigned(FListaIDProveedores) then begin for i := 0 to FListaIDProveedores.Count - 1 do begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_PedidosProveedorID_PROVEEDOR + ' = ' + IntToStr(FListaIDProveedores.Items[i]) + ') '; end; end; // Filtrar el informe por importe minimo if (FImporteMinimo > 0) then begin if Length(AWhereStr) > 0 then AWhereStr := AWhereStr + 'AND'; AWhereStr := AWhereStr + ' (' + fld_PedidosProveedorIMPORTE_TOTAL + ' >= ' + CurrToStr(FImporteMinimo) + ') '; end; ATabla.Where.AddText(AWhereStr); end; procedure TRptPedidosProveedor.RecuperarNombresProveedores; var AContactosService : IsrvContactos; Intf : IInterface; AClientID : TGUID; ATableNameArray: StringArray; ATableRequestInfoArray: TableRequestInfoArray; ATableRequestInfo: TableRequestInfoV5; AStream: TMemoryStream; ADataTable: TDAMemDataTable; i: Integer; AWhereBuilder : TDAWhereBuilder; ACondicion : TDAWhereExpression; begin CreateGUID(AClientID); GetClassFactory('srvContactos').CreateInstance(AClientID, Intf); if Assigned(Intf) then begin AContactosService := Intf as IsrvContactos; ATableNameArray := StringArray.Create; ATableRequestInfoArray := TableRequestInfoArray.Create; AWhereBuilder := TDAWhereBuilder.Create; try ATableNameArray.Add('Proveedores'); ATableRequestInfo := TableRequestInfoV5.Create; with ATableRequestInfo do begin IncludeSchema := True; MaxRecords := -1; UserFilter := ''; AWhereBuilder.Clear; with AWhereBuilder do for i := 0 to FListaIDProveedores.Count - 1 do begin ACondicion := NewBinaryExpression( NewBinaryExpression(NewField('', 'ID'), NewConstant(FListaIDProveedores[i], datInteger), dboEqual), NewBinaryExpression(NewField('', 'ID_EMPRESA'), NewConstant(FIdEmpresa, datInteger), dboEqual), dboAnd); if not AWhereBuilder.IsEmpty then Expression := NewBinaryExpression(Expression, ACondicion, dboOr) else Expression := ACondicion; end; WhereClause := AWhereBuilder.ExpressionToXmlNode(AWhereBuilder.Expression); end; try ATableRequestInfoArray.Add(ATableRequestInfo); AStream := AContactosService.GetData(ATableNameArray, ATableRequestInfoArray); if Assigned(AStream) then begin ADataTable := TDAMemDataTable.Create(nil); try ADataTable.Name := 'Proveedores'; ADataTable.LocalDataStreamer := DABin2DataStreamer1; ADataTable.RemoteFetchEnabled := False; DABin2DataStreamer1.ReadDataset(AStream, ADataTable, True); ADataTable.Open; FListaNombresProveedores.Clear; for i := 0 to ADataTable.RecordCount - 1 do begin FListaNombresProveedores.Add(ADataTable.FieldByName('NOMBRE').AsString); ADataTable.Next; end; finally FreeANDNil(ADataTable); end; end; except on e: Exception do dmServer.EscribirLog(e.Message); end; finally FreeANDNIL(ATableRequestInfoArray); FreeANDNIL(ATableNameArray); FreeANDNIL(AWhereBuilder); end; end; end; end.