{ =============================================================================== 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, FR_DBSet, DB, FR_View, FR_Shape, FR_IBXDB, TablaEmpresas, RdxEmpresaActiva; type TdmInformeBase = class(TDataModule) FReport: TfrReport; frShapeObject1: TfrShapeObject; frIBXComponents1: TfrIBXComponents; private FPreview : TfrPreview; function DarTextoDireccion(Index : Integer) : String; function DarTextoTelefonos(Index : Integer) : String; protected FBaseDatos : TIBDatabase; FTransaccion : TIBTransaction; FNombreInforme : String; procedure CargarInforme; procedure CrearVariables; virtual; 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; virtual; procedure Imprimir; virtual; published property Preview : TfrPreview read FPreview write SetPreview; property Report : TfrReport read FReport; end; implementation {$R *.dfm} uses StrFunc, Types, BaseDatos, Mensajes, Graphics; { TInformeBase } constructor TdmInformeBase.Create(AOwner: TComponent); begin inherited; FBaseDatos := dmBaseDatos.BD; FTransaccion := dmBaseDatos.Transaccion; end; destructor TdmInformeBase.Destroy; begin 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; CrearVariables; 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; iDir : Integer; Objeto : TfrView; ObjetoAux : 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('DatosEmpresa', Objeto.Name) > 0)) then begin with (Objeto as TfrMemoView) do begin Font.Name := 'Arial'; Prop['LINESPACING'] := 1; Prop['GAPX'] := 0; Prop['GAPY'] := 0; Memo.Clear; for iDir := 0 to (EmpresaActiva.Direcciones.Count - 1) do begin Memo.Add(DarTextoDireccion(iDir)); Memo.Add(DarTextoTelefonos(iDir)); Memo.Add(#151 + #151); end; CadenaAux := ''; if not EsCadenaVacia(EmpresaActiva.Web) then CadenaAux := EmpresaActiva.Web; if not EsCadenaVacia(EmpresaActiva.Correo) then begin if not EsCadenaVacia(CadenaAux) then CadenaAux := CadenaAux + ' · '; CadenaAux := CadenaAux + EmpresaActiva.Correo; end; Memo.Add(CadenaAux); CadenaAux := ''; if (not EsCadenaVacia(EmpresaActiva.NifCif)) then CadenaAux := ' NIF: ' + EmpresaActiva.NifCif; Memo.Add(EmpresaActiva.Nombre + CadenaAux); end; end; if ((Objeto is TfrPictureView) and (Pos('Logotipo', Objeto.Name) > 0)) then begin with (Objeto as TfrPictureView), EmpresaActiva do begin Picture.Assign(EmpresaActiva.Logotipo); end; 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; function TdmInformeBase.DarTextoDireccion(Index : Integer): String; var CadenaAux : String; begin with TListaDireccionesEmpresa(EmpresaActiva.Direcciones).Items[Index] do begin CadenaAux := Calle; if (not EsCadenaVacia(Numero)) then CadenaAux := CadenaAux + ', ' + Numero; if (not EsCadenaVacia(CodigoPostal)) then CadenaAux := CadenaAux + ' · ' + CodigoPostal; if (not EsCadenaVacia(Provincia)) then CadenaAux := CadenaAux + ' ' + Provincia; Result := CadenaAux; end; end; function TdmInformeBase.DarTextoTelefonos(Index : Integer): String; var CadenaAux : String; begin with TListaDireccionesEmpresa(EmpresaActiva.Direcciones).Items[Index] do begin CadenaAux := ''; if (not EsCadenaVacia(Telefono)) then CadenaAux := 'Telf. ' + Telefono; if (not EsCadenaVacia(Fax)) then CadenaAux := CadenaAux + ' Fax ' + Fax; Result := CadenaAux; end; end; procedure TdmInformeBase.CrearVariables; begin // end; end.