{ =============================================================================== Copyright (©) 2002. Rodax Software. =============================================================================== Los contenidos de este fichero son propiedad de Rodax Software titular del copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado, en su totalidad o en parte, con el permiso escrito de Rodax Software, o de acuerdo con los términos y condiciones establecidas en el acuerdo/contrato bajo el que se suministra. ----------------------------------------------------------------------------- Web: www.rodax-software.com =============================================================================== Fecha primera versión: 07-12-2002 Versión actual: 1.0.0 Fecha versión actual: 07-12-2002 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit InformeBase; interface uses SysUtils, Classes, FR_Class, IBDatabase, FR_DSet, forms, FR_DBSet, DB, FR_View, FR_Shape, FR_IBXDB, BaseDatos; type TGetParametersEvent = procedure(Memo : TStringList) of object; TdmInformeBase = class(TDataModule) FReport: TfrReport; frShapeObject1: TfrShapeObject; frIBXComponents1: TfrIBXComponents; private FPreview : TfrPreview; FOnGetParameters: TGetParametersEvent; protected FBaseDatos : TIBDatabase; FTransaccion : TIBTransaction; FNombreInforme : String; procedure CargarInforme; procedure PrepararConsultas; virtual; abstract; procedure RellenarCabecera(Band: TfrBand); virtual; procedure RellenarBanda(Band: TfrBand); virtual; procedure PrepararInforme; virtual; procedure FReportBeginBand(Band: TfrBand); virtual; procedure SetPreview (Value : TfrPreview); public constructor Create(AOwner : TComponent); override; destructor Destroy; override; procedure Previsualizar; procedure Imprimir; published property Preview : TfrPreview read FPreview write SetPreview; property Report : TfrReport read FReport; property OnGetParametersText : TGetParametersEvent read FOnGetParameters write FOnGetParameters; end; implementation {$R *.dfm} uses StrFunc, Mensajes, RdxEmpresaActiva; { TInformeBase } constructor TdmInformeBase.Create(AOwner: TComponent); begin inherited; FOnGetParameters := NIL; FBaseDatos := dmBaseDatos.BD; FTransaccion := dmBaseDatos.Transaccion; FReport := TfrReport.Create(Self); end; destructor TdmInformeBase.Destroy; begin FReport.Free; inherited; end; procedure TdmInformeBase.FReportBeginBand(Band: TfrBand); begin if Band.Typ = btPageHeader then RellenarCabecera(Band) else RellenarBanda(Band); end; procedure TdmInformeBase.PrepararInforme; begin PrepararConsultas; CargarInforme; FReport.OnBeginBand := FReportBeginBand; FReport.Preview := FPreview; end; procedure TdmInformeBase.Imprimir; begin PrepararInforme; FReport.PrepareReport; FReport.PrintPreparedReportDlg; end; procedure TdmInformeBase.Previsualizar; begin PrepararInforme; FReport.ShowReport; end; procedure TdmInformeBase.RellenarCabecera(Band: TfrBand); var iCont : Integer; Objeto : TfrView; CadenaAux : String; begin with Band do begin for iCont := 0 to Objects.Count - 1 do begin Objeto := Objects[iCont]; if ((Objeto is TfrMemoView) and (Pos('CabParametros', Objeto.Name) > 0)) then begin with (Objeto as TfrMemoView) do begin Memo.Clear; if Assigned(FOnGetParameters) then FOnGetParameters(Objeto.Memo); end end; { Logotipo y datos de la empresa } if ((Objeto is TfrMemoView) and (Pos('DatosEmpresa', Objeto.Name) > 0)) then begin with (Objeto as TfrMemoView), EmpresaActiva do begin Memo.Clear; Memo.Add(Nombre); if (not EsCadenaVacia(NifCif)) then CadenaAux := 'CIF: ' + NifCif; Memo.Add(CadenaAux); CadenaAux := ''; if (not EsCadenaVacia(Calle)) then begin CadenaAux := Calle; if (not EsCadenaVacia(Numero)) then CadenaAux := CadenaAux + ', ' + Numero; end; Memo.Add(CadenaAux); CadenaAux := ''; if (not EsCadenaVacia(CodigoPostal)) then CadenaAux := CodigoPostal; if (not EsCadenaVacia(Provincia)) then CadenaAux := CadenaAux + ' ' + Provincia; Memo.Add(CadenaAux); CadenaAux := ''; if (not EsCadenaVacia(Telefono)) then CadenaAux := 'Telf. ' + Telefono; if (not EsCadenaVacia(Fax)) then CadenaAux := CadenaAux + ' Fax ' + Fax; Memo.Add(CadenaAux); CadenaAux := ''; if (not EsCadenaVacia(Web)) then Memo.Add(Web); if (not EsCadenaVacia(Correo)) then Memo.Add(Correo); end; end; if (((Objeto is TfrPictureView) and (Pos('Logotipo', Objeto.Name) > 0))) then begin with (Objeto as TfrPictureView) do Picture.Assign(EmpresaActiva.Logotipo); end; end; end; end; procedure TdmInformeBase.SetPreview(Value: TfrPreview); begin FPreview := Value; end; procedure TdmInformeBase.CargarInforme; var RutaAux : String; begin RutaAux := ExtractFileDir(ParamStr(0))+ '\informes\' + FNombreInforme; if not FileExists(RutaAux) then raise Exception.CreateFmt('No se ha encontrado el informe %s.',[RutaAux]); FReport.LoadFromFile(RutaAux); end; procedure TdmInformeBase.RellenarBanda(Band: TfrBand); begin // end; end.