2007-06-21 16:02:50 +00:00
unit uBizContacto;
interface
uses
uDAInterfaces, uDADataTable, schContactosClient_Intf, Classes,
DBGrids, uDBSelectionList, DB, uExceptions, Controls;
const
CLIENTE = 1 ;
PROVEEDOR = 2 ;
INSTALADOR = 3 ;
VENDEDOR = 4 ;
BIZ_CLIENTE = 'Client.Cliente' ;
BIZ_PROVEEDOR = 'Client.Proveedor' ;
BIZ_VENDEDOR = 'Client.Vendedor' ;
BIZ_INSTALADOR = 'Client.Instalador' ;
BIZ_CATEGORIACONTACTO = 'Client.CategoriaContacto' ;
{ Contactos fields }
fld_ContactosCOMISION = 'COMISION' ;
type
IBizCategoriasContacto = interface( ICategoriasContacto)
[ '{2E0F9809-1E14-4382-A313-44CD363B3450}' ]
end ;
IBizContacto = interface( ICONTACTOS)
[ '{800A68B8-8C95-4CEB-B12A-C3D039ACDC14}' ]
function GetCategorias: IBizCategoriasContacto;
procedure SetCategorias( const Value: IBizCategoriasContacto) ;
property Categorias: IBizCategoriasContacto read GetCategorias write
SetCategorias;
procedure Show;
procedure ShowAll;
procedure Preview;
function ShowForSelect : TModalResult;
procedure CopyFrom( AContacto : IBizContacto) ;
end ;
IBizProveedor = interface( IBizContacto)
[ '{63B81D43-97D5-412F-99BF-891B5AC9920F}' ]
end ;
IBizCliente = interface( IBizContacto)
[ '{72BBFEB3-0315-4A8A-A9EA-BBC4CF20820E}' ]
end ;
IBizInstalador = interface( IBizContacto)
[ '{D70D7308-6A47-4D93-BAC4-FDC0CBD4CDB7}' ]
end ;
IBizVendedor = interface( IBizContacto)
[ '{A2B5FBCC-11C4-4723-A711-1EB413D2D1A4}' ]
function GetCOMISIONValue: Float;
procedure SetCOMISIONValue( const aValue: Float) ;
property COMISION: Float read GetCOMISIONValue write SetCOMISIONValue;
procedure CalcularComisiones;
end ;
TBizCategoriasContacto = class( TCategoriasContactoDataTableRules,
IBizCategoriasContacto)
end ;
TBizContactoDataTableRules = class( TCONTACTOSDataTableRules, IBizContacto,
IApplyUpdateFailedException, ISelectedRowList)
private
FCategorias: IBizCategoriasContacto;
FCategoriasLink: TDADataSource;
FSelectedRows : TSelectedRowList;
procedure ShowToSelect;
function OnApplyUpdateFailed: Boolean ;
protected
function GetCategorias: IBizCategoriasContacto;
procedure OnNewRecord( Sender: TDADataTable) ; override ;
procedure SetCategorias( const Value: IBizCategoriasContacto) ;
function GetSelectedRows : TSelectedRowList; virtual ;
procedure ShowApplyUpdateFailed ( const Error: EDAApplyUpdateFailed) ; virtual ;
procedure BeforeDelete( Sender: TDADataTable) ; override ;
procedure BeforeApplyUpdates( Sender : TDADataTable; const Delta : IDADelta) ;
procedure OnPostError( DataTable: TDADataTable; Error: EDatabaseError;
var Action: TDataAction) ; override ;
public
constructor Create( aDataTable: TDADataTable) ; override ;
destructor Destroy; override ;
procedure Show; virtual ;
procedure ShowAll; virtual ;
function ShowForSelect : TModalResult; virtual ;
procedure CopyFrom( AContacto : IBizContacto) ;
procedure Preview; virtual ;
property Categorias: IBizCategoriasContacto read GetCategorias write
SetCategorias;
property SelectedRows : TSelectedRowList read GetSelectedRows;
end ;
TBizProveedor = class( TBizContactoDataTableRules, IBizProveedor)
protected
procedure AfterPost( Sender: TDADataTable) ; override ;
public
procedure Show; override ;
procedure ShowAll; override ;
function ShowForSelect : TModalResult; override ;
end ;
TBizCliente = class( TBizContactoDataTableRules, IBizCliente)
protected
procedure AfterPost( Sender: TDADataTable) ; override ;
public
procedure ShowAll; override ;
procedure Show; override ;
function ShowForSelect : TModalResult; override ;
end ;
TBizInstalador = class( TBizContactoDataTableRules, IBizInstalador)
protected
procedure AfterPost( Sender: TDADataTable) ; override ;
public
procedure ShowAll; override ;
procedure Show; override ;
function ShowForSelect : TModalResult; override ;
end ;
TBizVendedor = class( TBizContactoDataTableRules, IBizVendedor)
protected
procedure AfterApplyUpdates( Sender : TDADataTable) ;
procedure AfterPost( Sender: TDADataTable) ; override ;
function GetCOMISIONValue: Float;
procedure SetCOMISIONValue( const aValue: Float) ;
procedure OnCalcFields( Sender: TDADataTable) ; override ;
public
procedure ShowAll; override ;
procedure Show; override ;
function ShowForSelect : TModalResult; override ;
procedure CalcularComisiones;
property COMISION: Float read GetCOMISIONValue write SetCOMISIONValue;
constructor Create( aDataTable: TDADataTable) ; override ;
end ;
procedure ValidarContacto ( const AContacto : IBizContacto) ;
implementation
uses
Windows, Dialogs, uDACDSDataTable, SysUtils, uEditorUtils,
uDataModuleContactos, uDataModuleBase, uDataModuleUsuarios, Variants,
uDataModuleComisiones;
procedure ValidarContacto ( const AContacto : IBizContacto) ;
begin
if Length( AContacto. NOMBRE) = 0 then
raise Exception. Create( 'Debe indicar al menos el nombre' ) ;
end ;
{
* * * * * * * * * * * * * * * * * * * * * * * * * * TBizContactoDataTableRules * * * * * * * * * * * * * * * * * * * * * * * * * *
}
constructor TBizContactoDataTableRules. Create( aDataTable: TDADataTable) ;
begin
inherited ;
FCategoriasLink : = TDADataSource. Create( NIL ) ;
FSelectedRows : = TSelectedRowList. Create( aDataTable) ;
aDataTable. OnBeforeApplyUpdates : = BeforeApplyUpdates;
end ;
destructor TBizContactoDataTableRules. Destroy;
begin
FCategorias : = NIL ;
FCategoriasLink. Free;
FSelectedRows. Free;
inherited ;
end ;
function TBizContactoDataTableRules. GetCategorias: IBizCategoriasContacto;
begin
Result : = FCategorias;
end ;
procedure TBizContactoDataTableRules. OnNewRecord( Sender: TDADataTable) ;
begin
inherited ;
CODIGOEMPRESA : = dmBase. CodigoEmpresa;
USUARIO : = dmUsuarios. LoginInfo. UserID;
FECHAALTA : = Date;
CODIGO : = dmContactos. GetNextAutoinc;
2014-07-14 17:22:53 +00:00
BAJA_LOGICA : = 0 ;
2007-06-21 16:02:50 +00:00
end ;
procedure TBizContactoDataTableRules. SetCategorias( const Value:
IBizCategoriasContacto) ;
begin
FCategorias : = Value;
FCategoriasLink. DataTable : = Self. DataTable;
FCategorias. DataTable. MasterSource : = FCategoriasLink;
end ;
procedure TBizContactoDataTableRules. Show;
begin
//
end ;
{ TBizCliente }
{
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * TBizCliente * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
}
procedure TBizCliente. AfterPost( Sender: TDADataTable) ;
begin
inherited ;
if ( Categorias. RecordCount = 0 ) then
begin
with Categorias do
begin
Insert;
CODIGOCATEGORIA : = CLIENTE;
Post;
end ;
end ;
end ;
procedure TBizCliente. Show;
begin
inherited ;
ShowEditor( IBizCliente, Self, etItem) ;
end ;
{ TBizCategoriasContactoDataTableRules }
{ TBizProveedor }
{
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * TBizProveedor * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
}
procedure TBizProveedor. AfterPost( Sender: TDADataTable) ;
begin
inherited ;
if ( Categorias. RecordCount = 0 ) then
begin
with Categorias do
begin
Insert;
CODIGOCATEGORIA : = PROVEEDOR;
Post;
end ;
end ;
end ;
procedure TBizProveedor. Show;
begin
inherited ;
ShowEditor( IBizProveedor, Self, etItem) ;
end ;
procedure TBizContactoDataTableRules. Preview;
begin
dmContactos. Preview;
end ;
procedure TBizContactoDataTableRules. ShowAll;
begin
//
end ;
procedure TBizCliente. ShowAll;
begin
inherited ;
ShowEditor( IBizCliente, Self, etItems) ;
end ;
procedure TBizProveedor. ShowAll;
begin
inherited ;
ShowEditor( IBizProveedor, Self, etItems) ;
end ;
function TBizContactoDataTableRules. GetSelectedRows: TSelectedRowList;
begin
Result : = FSelectedRows;
end ;
procedure TBizContactoDataTableRules. ShowToSelect;
begin
//
end ;
function TBizCliente. ShowForSelect : TModalResult;
begin
Result : = ShowEditor( IBizCliente, Self, etSelectItems) ;
end ;
function TBizContactoDataTableRules. ShowForSelect : TModalResult;
begin
//
end ;
function TBizProveedor. ShowForSelect : TModalResult;
begin
Result : = ShowEditor( IBizProveedor, Self, etSelectItems) ;
end ;
{ TBizInstalador }
procedure TBizInstalador. AfterPost( Sender: TDADataTable) ;
begin
inherited ;
if ( Categorias. RecordCount = 0 ) then
begin
with Categorias do
begin
Insert;
CODIGOCATEGORIA : = INSTALADOR;
Post;
end ;
end ;
end ;
procedure TBizInstalador. Show;
begin
inherited ;
ShowEditor( IBizInstalador, Self, etItem) ;
end ;
procedure TBizInstalador. ShowAll;
begin
inherited ;
ShowEditor( IBizInstalador, Self, etItems) ;
end ;
function TBizInstalador. ShowForSelect : TModalResult;
begin
Result : = ShowEditor( IBizInstalador, Self, etSelectItems) ;
end ;
function TBizContactoDataTableRules. OnApplyUpdateFailed: Boolean ;
begin
//
end ;
procedure TBizContactoDataTableRules. ShowApplyUpdateFailed(
const Error: EDAApplyUpdateFailed) ;
begin
if ( Pos( AUF_FKVIOLATION, Error. Message ) > 0 ) then
MessageBox( 0 , 'No se puede borrar este contacto porque tiene documentos dados de alta (como presupuestos, facturas, etc)' , 'Atenci<63> n' , MB_ICONWARNING or MB_OK) ;
end ;
procedure TBizContactoDataTableRules. BeforeDelete( Sender: TDADataTable) ;
begin
inherited ;
if not dmContactos. PuedoEliminarContacto( CODIGO) then
raise Exception. Create( 'No se puede borrar este contacto porque tiene documentos dados de alta (como presupuestos, facturas, etc' ) ;
end ;
{ TBizVendedor }
procedure TBizVendedor. AfterApplyUpdates( Sender: TDADataTable) ;
begin
dmComisiones. SetComision( CODIGO, COMISION) ;
end ;
procedure TBizVendedor. AfterPost( Sender: TDADataTable) ;
begin
inherited ;
if ( Categorias. RecordCount = 0 ) then
begin
with Categorias do
begin
Insert;
CODIGOCATEGORIA : = VENDEDOR;
Post;
end ;
end ;
end ;
procedure TBizVendedor. CalcularComisiones;
begin
dmComisiones. CalcularComisiones;
end ;
constructor TBizVendedor. Create( aDataTable: TDADataTable) ;
begin
inherited ;
aDataTable. OnAfterApplyUpdates : = AfterApplyUpdates;
end ;
function TBizVendedor. GetCOMISIONValue: Float;
begin
Result : = DataTable. FieldByName( fld_ContactosCOMISION) . AsFloat;
end ;
procedure TBizVendedor. OnCalcFields( Sender: TDADataTable) ;
begin
inherited ;
if VarIsNull( DataTable. FieldByName( fld_ContactosCOMISION) . AsVariant) and
not VarIsNull( DataTable. FieldByName( fld_ContactosCODIGO) . AsVariant) then
COMISION : = dmComisiones. GetComision( CODIGO) ;
end ;
procedure TBizVendedor. SetCOMISIONValue( const aValue: Float) ;
begin
DataTable. FieldByName( fld_ContactosCOMISION) . AsFloat : = aValue;
end ;
procedure TBizVendedor. Show;
begin
inherited ;
ShowEditor( IBizVendedor, Self, etItem) ;
end ;
procedure TBizVendedor. ShowAll;
begin
inherited ;
ShowEditor( IBizVendedor, Self, etItems) ;
end ;
function TBizVendedor. ShowForSelect: TModalResult;
begin
Result : = ShowEditor( IBizVendedor, Self, etSelectItems) ;
end ;
procedure TBizContactoDataTableRules. CopyFrom( AContacto: IBizContacto) ;
begin
//DataTable.DisableEventHandlers;
try
if not AContacto. DataTable. Active then
AContacto. DataTable. Active : = True ;
CODIGOEMPRESA : = AContacto. CODIGOEMPRESA;
NIFCIF : = AContacto. NIFCIF;
NOMBRE : = AContacto. NOMBRE;
CALLE : = AContacto. CALLE;
PROVINCIA : = AContacto. PROVINCIA;
POBLACION : = AContacto. POBLACION;
CODIGOPOSTAL : = AContacto. CODIGOPOSTAL;
CORREO1 : = AContacto. CORREO1;
CORREO2 : = AContacto. CORREO2;
TELEFONO1 : = AContacto. TELEFONO1;
TELEFONO2 : = AContacto. TELEFONO2;
MOVIL : = AContacto. MOVIL;
FAX : = AContacto. FAX;
NOTAS : = AContacto. NOTAS;
PERSONACONTACTO : = AContacto. PERSONACONTACTO;
PAGINAWEB : = AContacto. PAGINAWEB;
finally
//DataTable.EnableEventHandlers;
end ;
Post;
with Categorias do
begin
Insert;
CODIGOCATEGORIA : = AContacto. Categorias. CODIGOCATEGORIA;
Post;
end ;
end ;
procedure TBizContactoDataTableRules. BeforeApplyUpdates(
Sender: TDADataTable; const Delta: IDADelta) ;
var
i : integer ;
begin
for i : = 0 to Delta. Count - 1 do
case Delta. Changes[ i] . ChangeType of
ctInsert, ctUpdate : ValidarContacto( Self) ;
//ctDelete :
end ;
end ;
procedure TBizContactoDataTableRules. OnPostError( DataTable: TDADataTable;
Error: EDatabaseError; var Action: TDataAction) ;
begin
inherited ;
Action : = daAbort;
if ( Pos( AUF_HAVEVALUE, Error. Message ) > 0 ) then
begin
if ( Pos( 'Nombre' , Error. Message ) > 0 ) then
MessageBox( 0 , 'Debe indicar al menos el nombre' , 'Atenci<63> n' , MB_ICONWARNING or MB_OK)
else
raise Error;
end
else
raise Error;
end ;
initialization
RegisterDataTableRules( BIZ_CATEGORIACONTACTO, TBizCategoriasContacto) ;
RegisterDataTableRules( BIZ_CLIENTE, TBizCliente) ;
RegisterDataTableRules( BIZ_PROVEEDOR, TBizProveedor) ;
RegisterDataTableRules( BIZ_INSTALADOR, TBizInstalador) ;
RegisterDataTableRules( BIZ_VENDEDOR, TBizVendedor) ;
finalization
end .