This repository has been archived on 2024-11-29. You can view files and clone it, but cannot push or open issues or pull requests.
Tecsitel_FactuGES/Libreria/RdxEmpresaActiva.pas

230 lines
6.4 KiB
ObjectPascal
Raw Permalink Normal View History

{
===============================================================================
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: 30-04-2004
Versi<EFBFBD>n actual: 1.0.2
Fecha versi<EFBFBD>n actual: 05-08-2004
===============================================================================
Modificaciones:
Fecha Comentarios
---------------------------------------------------------------------------
30-07-2004 p284. Se han a<EFBFBD>adido los datos de inscripci<EFBFBD>n del Registro
Mercantil a la tabla de empresas.
05-08-2004 P279. A<EFBFBD>adido el campo 'MODELOINFORME' para determinar por
empresa qu<EFBFBD> formato usar<EFBFBD>n los informes (no internos).
===============================================================================
}
unit RdxEmpresaActiva;
interface
uses
//Generales
SysUtils, Classes, Controls, IBSQL, cxGridDBTableView, cxCustomData, DB,
IBDatabase,
//Particulares
IBCustomDataSet, Graphics, IBQuery,
//Aplicacion
Framework, StrFunc, Entidades, Constantes;
type
TEmpresaSingleton = class
private
FCodigo : Variant;
FNombre: String;
FNifCif: String;
FCalle: String;
FNumero: String;
FCodigoPostal: String;
FPoblacion: String;
FProvincia: String;
FTelefono: String;
FFax: String;
FCorreo: String;
FWeb: String;
FLogotipo : TPicture;
FRegistroMercantil : String;
FModeloInforme : Integer;
FDatabase : TIBDatabase;
FTransaction : TIBTransaction;
procedure ObtenerDatos;
procedure LimpiarCampos;
protected
procedure SetCodigo(const Value: Variant);
public
property Nombre : String read FNombre;
property NifCif : String read FNifCif;
property Calle : String read FCalle;
property Numero : String read FNumero;
property CodigoPostal : String read FCodigoPostal;
property Poblacion : String read FPoblacion;
property Provincia : String read FProvincia;
property Telefono : String read FTelefono;
property Fax : String read FFax;
property Correo : String read FCorreo;
property Web : String read FWeb;
property Logotipo : TPicture read FLogotipo;
property RegistroMercantil : String read FRegistroMercantil;
property ModeloInforme : Integer read FModeloInforme;
property Codigo : Variant read FCodigo write setCodigo;
property BD : TIBDatabase read FDatabase write FDatabase;
property Transaccion : TIBTransaction read FTransaction write FTransaction;
class function NewInstance: TObject; override;
procedure FreeInstance; override;
procedure Refrescar;
end;
var
EmpresaActiva : TEmpresaSingleton = Nil;
implementation
{ TEmpresaSingleton }
procedure TEmpresaSingleton.FreeInstance;
begin
if EmpresaActiva = Self then
begin
EmpresaActiva := NIL;
inherited FreeInstance;
end;
end;
procedure TEmpresaSingleton.LimpiarCampos;
begin
FNombre := '';
FNifCif := '';
FCalle := '';
FNumero := '';
FCodigoPostal := '';
FPoblacion := '';
FProvincia := '';
FTelefono := '';
FFax := '';
FCorreo := '';
FWeb := '';
FRegistroMercantil := '';
FModeloInforme := 0;
if FLogotipo <> Nil then
FLogotipo.Free;
FLogotipo := Nil;
end;
class function TEmpresaSingleton.NewInstance: TObject;
begin
if Assigned(EmpresaActiva) then
Exception.Create('No se puede tener mas de una instancia')
else begin
Result := inherited NewInstance;
with TEmpresaSingleton(Result) do
begin
FDatabase := NIL;
FTransaction := NIL;
FCodigo := NULL;
end;
end;
end;
procedure TEmpresaSingleton.ObtenerDatos;
var
oSQL : TIBQuery;
Stream : TIBDSBlobStream;
begin
LimpiarCampos;
if EsCadenaVacia(Codigo) then
exit;
oSQL := TIBQuery.Create(Nil);
with oSQL do
begin
Database := FDataBase;
Transaction := FTransaction;
SQL.Add('select * ');
SQL.Add('from EMPRESAS ');
SQL.Add('where CODIGO = :CODIGO');
try
ParamByName('CODIGO').AsInteger := Codigo;
Prepare;
Open;
// Compruebo si se han recuperado datos
if (RecordCount > 0) then
begin
FNombre := FieldByName('NOMBRE').AsString;
FNifCif := FieldByName('NIFCIF').AsString;
FCalle := FieldByName('CALLE').AsString;
FNumero := FieldByName('NUMERO').AsString;
FCodigoPostal := FieldByName('CODIGOPOSTAL').AsString;
FPoblacion := FieldByName('POBLACION').AsString;
FProvincia := FieldByName('PROVINCIA').AsString;
FTelefono := FieldByName('TELEFONO').AsString;
FFax := FieldByName('FAX').AsString;
FCorreo := FieldByName('CORREO').AsString;
FWeb := FieldByName('WEB').AsString;
FRegistroMercantil := FieldByName('REGISTROMERCANTIL').AsString;
FModeloInforme := FieldByName('MODELOINFORME').AsInteger;
//En el caso de que tenga logotipo asociado
if not esCadenaVacia(FieldByName('LOGOTIPO').AsVariant) then
begin
Stream := (oSQL.CreateBlobStream(FieldByName('LOGOTIPO'), bmReadWrite) as TIBDSBlobStream);
FLogotipo := TPicture.Create;
FLogotipo.Bitmap.LoadFromStream(Stream);
Stream.Free;
end;
end;
finally
Close;
Transaction := NIL;
Free;
end;
end;
end;
procedure TEmpresaSingleton.Refrescar;
begin
ObtenerDatos;
end;
procedure TEmpresaSingleton.SetCodigo(const Value: Variant);
begin
FCodigo := Value;
// Recuperar los datos de la empresa
ObtenerDatos;
end;
procedure LiberarEmpresaActiva; far;
Begin
if Assigned(EmpresaActiva) then
FreeAndNil(EmpresaActiva);
end;
initialization
EmpresaActiva := TEmpresaSingleton.Create;
SysUtils.AddExitProc(LiberarEmpresaActiva);
end.