This repository has been archived on 2024-11-28. You can view files and clone it, but cannot push or open issues or pull requests.
LuisLeon_FactuGES/Source/Modulos/Pedidos de cliente/Reports/uRptPedidosCliente_Server.pas

147 lines
4.4 KiB
ObjectPascal

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, FactuGES_Intf, frxExportPDF;
type
TRptPedidosCliente = class(TDataModule)
DADataCabecera: TDADataSource;
DADataDetalles: TDADataSource;
tbl_Cabecera: TDACDSDataTable;
tbl_Detalles: TDACDSDataTable;
DABINAdapter: TDABINAdapter;
frxRichObject1: TfrxRichObject;
frxBarCodeObject1: TfrxBarCodeObject;
frxOLEObject1: TfrxOLEObject;
frxCrossObject1: TfrxCrossObject;
frxCheckBoxObject1: TfrxCheckBoxObject;
frxGradientObject1: TfrxGradientObject;
frxChartObject1: TfrxChartObject;
frxDBCabecera: TfrxDBDataset;
frxDBDetalles: TfrxDBDataset;
schReport: TDASchema;
DataDictionary: TDADataDictionary;
frxReport: TfrxReport;
frxPDFExport1: TfrxPDFExport;
procedure DataModuleCreate(Sender: TObject);
procedure frxReportGetValue(const VarName: string; var Value: Variant);
private
FConnection: IDAConnection;
FShowLogotipo: Boolean;
procedure _GenerarPedido(const AID : Integer); overload;
public
function GenerarPedido(const AID : String; const AConLogotipo: Boolean = False): Binary; overload;
function GenerarReportEnPDF(const ListaID : TIntegerArray; const AConLogotipo: Boolean = False): Binary;
end;
implementation
{$R *.dfm}
uses
uDataModuleServer, schPedidosClienteClient_Intf;
const
rptInforme = 'InfPedidoCliente.fr3';
{ Dataset names for schReport }
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;
end;
function TRptPedidosCliente.GenerarPedido(const AID: String; const AConLogotipo: Boolean = False): Binary;
var
ID_Pedidos: TStringList;
i: Integer;
begin
Result := Binary.Create;
try
FShowLogotipo := AConLogotipo;
ID_Pedidos := TStringList.Create;
ID_Pedidos.CommaText := AID;
//Vamos generando todos y cada uno de los albaranes recibidos
for i := 0 to ID_Pedidos.Count - 1 do
_GenerarPedido(StrToInt(ID_Pedidos.Strings[i]));
frxReport.PreviewPages.SaveToStream(Result);
finally
end;
end;
function TRptPedidosCliente.GenerarReportEnPDF(const ListaID: TIntegerArray;
const AConLogotipo: Boolean): Binary;
var
i: Integer;
begin
FShowLogotipo := AConLogotipo;
Result := Binary.Create;
try
//Vamos generando todos y cada uno de los presupuestos recibidos
for i := 0 to ListaID.Count - 1 do
_GenerarPedido(ListaID.Items[i]);
frxPDFExport1.Stream := Result;
frxReport.Export(frxPDFExport1)
finally
end;
end;
procedure TRptPedidosCliente.frxReportGetValue(const VarName: string;
var Value: Variant);
begin
if VarName = 'ShowLogotipo' then
Value := FShowLogotipo;
end;
procedure TRptPedidosCliente._GenerarPedido(const AID: Integer);
var
AStream: TMemoryStream;
dsMaster: IDADataset;
dsDetail: IDADataset;
begin
AStream := TMemoryStream.Create;
FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
try
dsMaster := schReport.NewDataset(FConnection, ds_InformeCabecera, ['ID'], [AID]);
dsDetail := schReport.NewDataset(FConnection, ds_InformeDetalles, ['ID_PEDIDO'], [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 + rptInforme, True);
frxReport.PrepareReport(False);
finally
FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO"
AStream.Free;
dsMaster := Nil;
dsDetail := Nil;
end;
end;
end.