{ =============================================================================== 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: 30-04-2004 Versión actual: 1.0.1 Fecha versión actual: 13-07-2004 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- 13-07-2004 Al cambiar de empresa, no se eliminaba el logotipo anterior. =============================================================================== } unit RdxEmpresaActiva; interface uses //Generales SysUtils, Classes, Controls, Graphics, {IBSQL, cxGridDBTableView, cxCustomData, DB, IBDatabase, //Particulares IBCustomDataSet, Graphics, IBQuery, Variants,} //Aplicacion StrFunc, Framework; type TEmpresaSingleton = class private FDatosEmpresa : TObjeto; function GetCodigo: Integer; function GetCodigoTrimestre: String; function GetCorreo: String; function GetDirecciones: TListaObjetos; function GetFechaAlta: String; function GetIvaDefecto: String; function GetLibroDefecto: String; function GetLogotipo: TPicture; function GetNifCif: String; function GetNombre: String; function GetNombreComercial: String; function GetUsuario: String; function GetValidezDefecto: Variant; function GetIntervaloPagosCli: Real; function GetWeb: String; procedure SetCodigo(const Value: Integer); public property Codigo : Integer read GetCodigo write SetCodigo; property FechaAlta : String read GetFechaAlta; property Usuario : String read GetUsuario; property Nombre : String read GetNombre; property NifCif : String read GetNifCif; property Correo : String read GetCorreo; property Web : String read GetWeb; property NombreComercial : String read GetNombreComercial; property CodigoTrimestre : String read GetCodigoTrimestre; property IvaDefecto : String read GetIvaDefecto; property ValidezDefecto : Variant read GetValidezDefecto; property IntervaloPagosCli : Real read GetIntervaloPagosCli; property LibroDefecto : String read GetLibroDefecto; property Logotipo : TPicture read GetLogotipo; property Direcciones : TListaObjetos read GetDirecciones; class function NewInstance: TObject; override; procedure FreeInstance; override; procedure Refrescar; end; procedure LiberarEmpresaActiva; var EmpresaActiva : TEmpresaSingleton = Nil; implementation uses TablaEmpresas; { TEmpresaSingleton } procedure TEmpresaSingleton.FreeInstance; begin if EmpresaActiva = Self then begin EmpresaActiva := NIL; inherited FreeInstance; end; end; function TEmpresaSingleton.GetCodigo: Integer; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Codigo else Result := -1; end; function TEmpresaSingleton.GetCodigoTrimestre: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).CodigoTrimestre else Result := ''; end; function TEmpresaSingleton.GetCorreo: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Correo else Result := ''; end; function TEmpresaSingleton.GetDirecciones: TListaObjetos; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Direcciones else Result := NIL; end; function TEmpresaSingleton.GetFechaAlta: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).FechaAlta else Result := ''; end; function TEmpresaSingleton.GetIntervaloPagosCli: Real; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).IntervaloPagosCli else Result := 0; end; function TEmpresaSingleton.GetIvaDefecto: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).IvaDefecto else Result := ''; end; function TEmpresaSingleton.GetLibroDefecto: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).LibroDefecto else Result := ''; end; function TEmpresaSingleton.GetLogotipo: TPicture; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Logotipo else Result := NIL; end; function TEmpresaSingleton.GetNifCif: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).NifCif else Result := ''; end; function TEmpresaSingleton.GetNombre: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Nombre else Result := ''; end; function TEmpresaSingleton.GetNombreComercial: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).NombreComercial else Result := ''; end; function TEmpresaSingleton.GetUsuario: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Usuario else Result := ''; end; function TEmpresaSingleton.GetValidezDefecto: Variant; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).ValidezDefecto else Result := ''; end; function TEmpresaSingleton.GetWeb: String; begin if Assigned(FDatosEmpresa) then Result := (FDatosEmpresa as TDatosEmpresa).Web else Result := ''; end; class function TEmpresaSingleton.NewInstance: TObject; begin if Assigned(EmpresaActiva) then Exception.Create('No se puede tener mas de una instancia') else Result := inherited NewInstance; end; procedure TEmpresaSingleton.Refrescar; var CodAux : Integer; begin CodAux := (FDatosEmpresa as TDatosEmpresa).Codigo; FDatosEmpresa.Free; FDatosEmpresa := NIL; Self.Codigo := CodAux; end; procedure TEmpresaSingleton.SetCodigo(const Value: Integer); begin if Assigned(FDatosEmpresa) then begin if (FDatosEmpresa as TDatosEmpresa).Codigo <> Value then FDatosEmpresa.Free else Exit; end; FDatosEmpresa := TDatosEmpresa.Create(Value); end; procedure LiberarEmpresaActiva; far; Begin if Assigned(EmpresaActiva) then FreeAndNil(EmpresaActiva); end; initialization EmpresaActiva := TEmpresaSingleton.Create; SysUtils.AddExitProc(LiberarEmpresaActiva); end. end.