Tecsitel_FactuGES2/Source/Modulos/Albaranes de cliente/Reports/uRptAlbaranesCliente_Server.pas

192 lines
6.2 KiB
ObjectPascal

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, frxExportPDF, FactuGES_Intf;
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;
tbl_Cabecera: TDAMemDataTable;
tbl_Detalles: TDAMemDataTable;
frxPDFExport1: TfrxPDFExport;
schReport: TDASchema;
procedure DataModuleCreate(Sender: TObject);
private
FConnection: IDAConnection;
//Genera cada uno de los albaranes a imprimir
procedure _GenerarAlbaran(const AID: Integer);
public
function GenerarAlbaran(const AListaID : TIntegerArray): Binary;
function GenerarEtiquetas(const AID : Integer; withRefCliente: Boolean): Binary;
function GenerarAlbaranEnPDF(const ListaID : TIntegerArray): 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;
frxDBCabecera.DataSource := DADSCabecera;
frxDBDetalles.DataSource := DADSDetalles;
end;
function TRptAlbaranesCliente.GenerarAlbaran(const AListaID : TIntegerArray): Binary;
var
i: Integer;
begin
Result := Binary.Create;
//FConnection.BeginTransaction; <--- Creo que no va a hacer falta.
try
//Vamos generando todos y cada uno de los albaranes recibidos
for i := 0 to AListaID.Count - 1 do
_GenerarAlbaran(AListaID.Items[i]);
frxReport.PreviewPages.SaveToStream(Result);
finally
//FConnection.RollbackTransaction; <--- Creo que no va a hacer falta.
end;
end;
function TRptAlbaranesCliente.GenerarAlbaranEnPDF(
const ListaID: TIntegerArray): Binary;
var
i: Integer;
begin
Result := Binary.Create;
//FConnection.BeginTransaction; <--- Creo que no va a hacer falta.
try
//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)
finally
//FConnection.RollbackTransaction; <--- Creo que no va a hacer falta.
end;
end;
procedure TRptAlbaranesCliente._GenerarAlbaran(const AID: Integer);
begin
tbl_Cabecera.Active := False;
tbl_Detalles.Active := False;
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);
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.