unit uRptPedidosCliente_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 TRptPedidosCliente = 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; FShowLogotipo: Boolean; 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 = 'InfPedidoCliente.fr3'; rptInformeListadoPedidosDesglosado = 'InformeListadoPedidosDesglosado.fr3'; rptInformeListadoPedidos = 'InformeListadoPedidos.fr3'; { Dataset names for schReport } ds_InformeListadoPedidosResumen = 'InformeListadoPedidosResumen'; ds_InformeCabecera = 'Informe_Cabecera'; ds_InformeDetalles = 'Informe_Detalles'; { TRptPedidosProveedor } procedure TRptPedidosCliente.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 TRptPedidosCliente.DataModuleDestroy(Sender: TObject); begin tbl_Cabecera.Active := False; tbl_Detalles.Active := False; FreeANDNIL(FListaNombresProveedores); end; procedure TRptPedidosCliente.frxReportGetValue(const VarName: string; var Value: Variant); begin if VarName = 'ShowLogotipo' then Value := FShowLogotipo; if VarName = 'ImprimirPrecio' then Value := FImprimirPrecio; if VarName = 'ImprimirRefProveedor' then Value := FImprimirRefProveedor; end; function TRptPedidosCliente.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 TRptPedidosCliente.GenerarPedido(const ListaID : TIntegerArray; const ImprimirPrecio: Boolean = True; const ImprimirRefProveedor: Boolean = True): Binary; var i: Integer; begin Result := Binary.Create; FShowLogotipo:= True; 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 TRptPedidosCliente._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 TRptPedidosCliente._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 TRptPedidosCliente.GenerarPedidoEnPDF( const ListaID: TIntegerArray; const ImprimirPrecio: Boolean; const ImprimirRefProveedor: Boolean): Binary; var i: Integer; begin Result := Binary.Create; FShowLogotipo:= True; 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 TRptPedidosCliente.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 TRptPedidosCliente.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 TRptPedidosCliente.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 TRptPedidosCliente.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.