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; BAJA_LOGICA := 0; 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ó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ó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.