230 lines
6.5 KiB
ObjectPascal
230 lines
6.5 KiB
ObjectPascal
|
|
{
|
|||
|
|
===============================================================================
|
|||
|
|
Copyright (<EFBFBD>) 2002. Rodax Software.
|
|||
|
|
===============================================================================
|
|||
|
|
Los contenidos de este fichero son propiedad de Rodax Software titular del
|
|||
|
|
copyright. Este fichero s<EFBFBD>lo podr<EFBFBD> ser copiado, distribuido y utilizado,
|
|||
|
|
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
|
|||
|
|
acuerdo con los t<EFBFBD>rminos y condiciones establecidas en el acuerdo/contrato
|
|||
|
|
bajo el que se suministra.
|
|||
|
|
-----------------------------------------------------------------------------
|
|||
|
|
Web: www.rodax-software.com
|
|||
|
|
===============================================================================
|
|||
|
|
Fecha primera versi<EFBFBD>n: 07-12-2002
|
|||
|
|
Versi<EFBFBD>n actual: 1.0.0
|
|||
|
|
Fecha versi<EFBFBD>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 + ' <20> ';
|
|||
|
|
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 + ' <20> ' + 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.
|