{ =============================================================================== Copyright (©) 2006. 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: 22-05-2006 Versión actual: 1.0.0 Fecha versión actual: 22-05-2006 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit uBizObra; interface uses uDAInterfaces, uDADataTable, schObrasClient_Intf, Classes, uDBSelectionList, uBizContacto, uBizDocumentosAsociados, uExceptions, DB; const CTE_NO_ACEPTADO = 0; CTE_ACEPTADO = 1; CTE_NO_APLICARET = 0; CTE_APLICARET = 1; CTE_SI = 1; CTE_NO = 0; BIZ_FECINIFIN = 'IBizFechIniFin'; BIZ_RETENCION = 'IBizRetencion'; BIZ_PRESUPUESTOFIN = 'IBizPresupuestoFin'; BIZ_CALCULOHONORARIOS = 'IBizCalculoHonorarios'; BIZ_OBRA = 'IBizObra'; TIPO_NUEVA = 'Nueva'; TIPO_REFORMA = 'Reforma'; APLICA_INICIALES = 'I'; APLICA_FINALES = 'F'; BIZ_CONTACTOOBRA = 'IBizContactoObra'; BIZ_PRESUPUESTOOBRA = 'IBizPresupuestosObra'; TIPO_OBRA = 'Obra'; TIPO_DECORACION = 'Decoración'; CLASE_PRESUPUESTO = 'P'; CLASE_TRABAJO = 'T'; BIZ_PROYECTOSOBRA = 'IBizProyectosObra'; TIPO_ANTEPROYECTO = 'Anteproyecto'; TIPO_BASICO = 'Básico'; TIPO_EJECUCION = 'Ejecución'; TIPO_SEGURIDAD = 'Seguridad y salud'; type IBizContactosObra = Interface; //Se declara después IBizPresupuestosObra = Interface; //Se declara después IBizProyectosObra = Interface; //Se declara después IBizFechIniFin = interface(IDAStronglyTypedDataTable) ['{3314A451-6459-4AA2-8FF0-6839E8DB4DF9}'] end; IBizRetencion = interface(IDAStronglyTypedDataTable) ['{A9F01C6C-51E3-40B6-A0A9-89EBB6FA30D0}'] end; IBizPresupuestoFin = interface(IDAStronglyTypedDataTable) ['{F89BF21F-75EA-4590-B405-E409DEDFB264}'] end; IBizCalculoHonorarios = interface(IDAStronglyTypedDataTable) ['{AC4260F0-6E7C-468A-A66E-5C2BC6F60D26}'] end; IBizObra = interface(IObras) ['{AEEE5384-72C2-4592-AC3A-0C70007906F9}'] function GetCliente: IBizContacto; procedure SetCliente(const Value: IBizContacto); property Cliente: IBizContacto read GetCliente write SetCliente; function GetContactos: IBizContactosObra; procedure SetContactos(const Value: IBizContactosObra); property Contactos: IBizContactosObra read GetContactos write SetContactos; function GetPresupuestos: IBizPresupuestosObra; procedure SetPresupuestos(const Value: IBizPresupuestosObra); property Presupuestos: IBizPresupuestosObra read GetPresupuestos write SetPresupuestos; function GetProyectos: IBizProyectosObra; procedure SetProyectos(const Value: IBizProyectosObra); property Proyectos: IBizProyectosObra read GetProyectos write SetProyectos; procedure Show; end; IBizContactosObra = interface(IContactosObra) ['{96FCDCCF-6FAC-4ABB-B3A3-F563315EBEA6}'] function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); property Obra: IBizObra read GetObra write SetObra; function GetContacto: IBizContacto; procedure SetContacto(const Value: IBizContacto); property Contacto: IBizContacto read GetContacto write SetContacto; function GetPresupuestos: IBizPresupuestosObra; procedure SetPresupuestos(const Value: IBizPresupuestosObra); property Presupuestos: IBizPresupuestosObra read GetPresupuestos write SetPresupuestos; procedure AppendContactos(AContactos: IBizContacto); procedure Show; end; IBizPresupuestosObra = interface (IPresupuestosObra) ['{106611B9-0327-48A2-AA4B-48F12BAAB5E2}'] function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); property Obra: IBizObra read GetObra write SetObra; function GetContacto: IBizContacto; procedure SetContacto(const Value: IBizContacto); property Contacto: IBizContacto read GetContacto write SetContacto; procedure Show; procedure AdjuntarContacto; end; IBizProyectosObra = interface (IProyectosObra) ['{7AD421E5-67AB-40CF-A551-A9C1DCFA6868}'] function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); property Obra: IBizObra read GetObra write SetObra; procedure Show; end; TBizFecIniFinFieldRules = class(TDAFieldRules) protected procedure OnChange(Sender: TDACustomField); override; end; TBizRetencionFieldRules = class(TDAFieldRules) protected procedure OnChange(Sender: TDACustomField); override; end; TBizPresupuestoFinFieldRules = class(TDAFieldRules) protected procedure OnChange(Sender: TDACustomField); override; end; TBizCalculoHonorariosFieldRules = class(TDAFieldRules) protected procedure OnChange(Sender: TDACustomField); override; end; TBizObraDataTableRules = class(TOBRASDataTableRules, IBizObra, IBizFechIniFin, IApplyUpdateFailedException, ISelectedRowList, IBizCalculoHonorarios, IBizDocumentosAsociados) private FCliente: IBizContacto; FClienteLink: TDADataSource; FContactos: IBizContactosObra; FContactosLink: TDADataSource; FPresupuestos: IBizPresupuestosObra; FPresupuestosLink: TDADataSource; FProyectos: IBizProyectosObra; FProyectosLink: TDADataSource; FSelectedRows : TSelectedRowList; //DOCUMENTOS ASOCIADOS FGestorDocumentos: TGestorDocumentos; FGestorDocumentosNuevo: TGestorDocumentos; function GetGestorDocumentos: TGestorDocumentos; procedure SetGestorDocumentos(Value: TGestorDocumentos); function GetGestorDocumentosNuevo: TGestorDocumentos; procedure SetGestorDocumentosNuevo(Value: TGestorDocumentos); protected procedure OnNewRecord(Sender: TDADataTable); override; procedure BeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); procedure ShowApplyUpdateFailed (const Error: EDAApplyUpdateFailed); virtual; procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); override; function GetSelectedRows : TSelectedRowList; virtual; function GetCliente: IBizContacto; procedure SetCliente(const Value: IBizContacto); function GetContactos: IBizContactosObra; procedure SetContactos(const Value: IBizContactosObra); function GetPresupuestos: IBizPresupuestosObra; procedure SetPresupuestos(const Value: IBizPresupuestosObra); function GetProyectos: IBizProyectosObra; procedure SetProyectos(const Value: IBizProyectosObra); //DOCUMENTOS ASOCIADOS procedure BeforeDelete(Sender: TDADataTable); override; procedure BeforeCancel(Sender: TDADataTable); override; procedure AfterCancel(Sender: TDADataTable); override; public property Cliente: IBizContacto read GetCliente write SetCliente; property Contactos: IBizContactosObra read GetContactos write SetContactos; property Presupuestos: IBizPresupuestosObra read GetPresupuestos write SetPresupuestos; property Proyectos: IBizProyectosObra read GetProyectos write SetProyectos; property SelectedRows : TSelectedRowList read GetSelectedRows; //DOCUMENTOS ASOCIADOS property GestorDocumentos: TGestorDocumentos read GetGestorDocumentos write SetGestorDocumentos; property GestorDocumentosNuevo: TGestorDocumentos read GetGestorDocumentosNuevo write SetGestorDocumentosNuevo; constructor Create(aDataTable: TDADataTable); override; destructor Destroy; override; procedure Show; virtual; // function ShowForSelect: TModalResult; end; TBizContactosObraDataTableRules = class(TContactosObraDataTableRules, IBizContactosObra) private FObra: IBizObra; FContacto: IBizContacto; FPresupuestos: IBizPresupuestosObra; protected function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); function GetContacto: IBizContacto; procedure SetContacto(const Value: IBizContacto); function GetPresupuestos: IBizPresupuestosObra; procedure SetPresupuestos(const Value: IBizPresupuestosObra); public property Obra: IBizObra read GetObra write SetObra; property Contacto: IBizContacto read GetContacto write SetContacto; property Presupuestos: IBizPresupuestosObra read GetPresupuestos write SetPresupuestos; destructor Destroy; override; procedure AppendContactos(AContactos: IBizContacto); procedure Show; end; TBizPresupuestosDataTableRules = class(TPresupuestosObraDataTableRules, IBizPresupuestosObra, IApplyUpdateFailedException, ISelectedRowList, IBizRetencion, IBizPresupuestoFin) private FObra: IBizObra; FContacto: IBizContacto; FSelectedRows : TSelectedRowList; protected procedure OnNewRecord(Sender: TDADataTable); override; procedure ShowApplyUpdateFailed (const Error: EDAApplyUpdateFailed); virtual; procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); override; procedure AfterPost(DataTable: TDADataTable); override; procedure AfterDelete(DataTable: TDADataTable); override; function GetSelectedRows : TSelectedRowList; virtual; function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); function GetContacto: IBizContacto; procedure SetContacto(const Value: IBizContacto); public property Obra: IBizObra read GetObra write SetObra; property Contacto: IBizContacto read GetContacto write SetContacto; property SelectedRows : TSelectedRowList read GetSelectedRows; constructor Create(aDataTable: TDADataTable); override; destructor Destroy; override; procedure Show; procedure AdjuntarContacto; end; TBizProyectosDataTableRules = class(TProyectosObraDataTableRules, IBizProyectosObra, IApplyUpdateFailedException, ISelectedRowList, IBizDocumentosAsociados) private FObra: IBizObra; FSelectedRows : TSelectedRowList; //DOCUMENTOS ASOCIADOS FGestorDocumentos: TGestorDocumentos; FGestorDocumentosNuevo: TGestorDocumentos; function GetGestorDocumentos: TGestorDocumentos; procedure SetGestorDocumentos(Value: TGestorDocumentos); function GetGestorDocumentosNuevo: TGestorDocumentos; procedure SetGestorDocumentosNuevo(Value: TGestorDocumentos); protected procedure OnNewRecord(Sender: TDADataTable); override; procedure BeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); procedure ShowApplyUpdateFailed (const Error: EDAApplyUpdateFailed); virtual; procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); override; function GetSelectedRows : TSelectedRowList; virtual; function GetObra: IBizObra; procedure SetObra(const Value: IBizObra); //DOCUMENTOS ASOCIADOS procedure BeforeDelete(Sender: TDADataTable); override; procedure BeforeCancel(Sender: TDADataTable); override; procedure AfterCancel(Sender: TDADataTable); override; public property Obra: IBizObra read GetObra write SetObra; property SelectedRows : TSelectedRowList read GetSelectedRows; //DOCUMENTOS ASOCIADOS property GestorDocumentos: TGestorDocumentos read GetGestorDocumentos write SetGestorDocumentos; property GestorDocumentosNuevo: TGestorDocumentos read GetGestorDocumentosNuevo write SetGestorDocumentosNuevo; constructor Create(aDataTable: TDADataTable); override; destructor Destroy; override; procedure Show; end; procedure ValidarObra (const AObj : IBizObra); procedure CalcularImporteRetencion(aDataTable : TDADataTable); procedure CalcularTotalPresupuestos(aDataTable : TDADataTable); procedure CalcularHonorarios(aDataTable : TDADataTable); implementation uses Windows, Controls, Forms, Dialogs, uDACDSDataTable, SysUtils, uEditorUtils, uDataModuleObras, schContactosClient_Intf, uUtils, LiteralesObras, Variants, uDataModuleContactos, uDataModuleBase, cxControls; procedure ValidarObra (const AObj : IBizObra); begin if (not AObj.DataTable.IsEmpty) and (LENGTH(AObj.TIPO) = 0) then raise Exception.Create(msgLitTipoObraObligatorio); end; procedure CalcularImporteRetencion(aDataTable : TDADataTable); var ImporteTotal: Double; begin if not Assigned(aDataTable) then raise Exception.Create('Tabla no asignada (CalcularImporteRetencion)'); ImporteTotal := aDataTable.FindField(fld_PresupuestosObraPRESUPUESTOFINAL).AsCurrency; ImporteTotal := ImporteTotal * aDataTable.FindField(fld_PresupuestosObraRETENCION).AsFloat; ImporteTotal := ImporteTotal / 100; aDataTable.FieldByName(fld_PresupuestosObraIMPORTERETENCION).AsCurrency := ImporteTotal; end; procedure CalcularTotalPresupuestos(aDataTable : TDADataTable); var ABookmark : Pointer; ACursor: TCursor; EnEdicion: Boolean; TotalIni: Double; TotalFin: Double; ClaseField : TDAField; AceptadoField : TDAField; TotalIniField : TDAField; TotalFinField : TDAField; begin if not Assigned(aDataTable) then raise Exception.Create('Tabla no asignada (CalcularTotalPresupuestos)'); ClaseField := aDataTable.FindField(fld_PresupuestosObraCLASE); if not Assigned(ClaseField) then raise Exception.Create('Campo CLASE no encontrado (CalcularTotalPresupuestos)'); AceptadoField := aDataTable.FindField(fld_PresupuestosObraACEPTADO); if not Assigned(AceptadoField) then raise Exception.Create('Campo ACEPTADO no encontrado (CalcularTotalPresupuestos)'); ABookmark := aDataTable.GetBookMark; ACursor := Screen.Cursor; Screen.Cursor := crHourGlass; aDataTable.DisableControls; try TotalIni:= 0; TotalFin:= 0; aDataTable.First; while not aDataTable.EOF do begin if (ClaseField.AsString = CLASE_PRESUPUESTO) and (AceptadoField.AsInteger = CTE_ACEPTADO) then begin TotalIni:= TotalIni + aDataTable.FieldByName(fld_PresupuestosObraPRESUPUESTOINICIAL).AsCurrency; TotalFin:= TotalFin + aDataTable.FieldByName(fld_PresupuestosObraPRESUPUESTOFINAL).AsCurrency; end; aDataTable.Next; end; if Assigned(aDataTable.MasterSource) then begin with aDataTable.MasterSource do begin TotalIniField := DataTable.FindField(fld_ObrasTOTALPRESUPUESTOSINI ); if not Assigned(TotalIniField) then raise Exception.Create('Campo TOTALPRESUPUESTOINI no encontrado (CalcularTotalPresupuestos)'); TotalFinField := DataTable.FindField(fld_ObrasTOTALPRESUPUESTOSFIN); if not Assigned(TotalFinField) then raise Exception.Create('Campo TOTALPRESUPUESTOFIN no encontrado (CalcularTotalPresupuestos)'); EnEdicion := (DataTable.State in dsEditModes); if not EnEdicion then DataTable.Edit; TotalIniField.AsCurrency := TotalIni; TotalFinField.AsCurrency := TotalFin; DataTable.Post; if EnEdicion then DataTable.Edit; end; end; finally aDataTable.GotoBookmark(ABookmark); aDataTable.EnableControls; Screen.Cursor := ACursor; end; end; procedure CalcularHonorarios(aDataTable : TDADataTable); var AplicaHonorariosField : TDAField; ImporteTotal : Double; begin if not Assigned(aDataTable) then raise Exception.Create('Tabla no asignada (CalcularHonorarios)'); AplicaHonorariosField := aDataTable.FindField(fld_ObrasAPLICAHONORARIOS); if not Assigned(AplicaHonorariosField) then raise Exception.Create('Campo APLICAHONORARIOS no encontrado (CalcularTotalPresupuestos)'); if AplicaHonorariosField.AsString = APLICA_INICIALES then begin ImporteTotal := aDataTable.FindField(fld_ObrasTOTALPRESUPUESTOSINI).AsCurrency; ImporteTotal := ImporteTotal * aDataTable.FindField(fld_ObrasHONORARIOS).AsFloat; ImporteTotal := ImporteTotal / 100; aDataTable.FieldByName(fld_ObrasIMPORTEHONORARIOS).AsCurrency := ImporteTotal; end else begin ImporteTotal := aDataTable.FindField(fld_ObrasTOTALPRESUPUESTOSFIN).AsCurrency; ImporteTotal := ImporteTotal * aDataTable.FindField(fld_ObrasHONORARIOS).AsFloat; ImporteTotal := ImporteTotal / 100; aDataTable.FieldByName(fld_ObrasIMPORTEHONORARIOS).AsCurrency := ImporteTotal; end; end; { TBizObraDataTableRules } { ************************** TBizObraDataTableRules ************************** } procedure TBizObraDataTableRules.AfterCancel(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.Directorio := NOMBRE; GestorDocumentosNuevo.Directorio := NOMBRE; end; procedure TBizObraDataTableRules.BeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); begin ValidarObra(Self); end; procedure TBizObraDataTableRules.BeforeCancel(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.procesarCancelTable; GestorDocumentosNuevo.procesarCancelTable; end; procedure TBizObraDataTableRules.BeforeDelete(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.procesarDeleteTable; GestorDocumentosNuevo.procesarDeleteTable; end; constructor TBizObraDataTableRules.Create(aDataTable: TDADataTable); begin inherited; FClienteLink := TDADataSource.Create(NIL); FContactosLink := TDADataSource.Create(NIL); FPresupuestosLink := TDADataSource.Create(NIL); FProyectosLink := TDADataSource.Create(NIL); FSelectedRows := TSelectedRowList.Create(aDataTable); aDataTable.OnBeforeApplyUpdates := BeforeApplyUpdates; //DOCUMENTOS ASOCIADOS FGestorDocumentos := TGestorDocumentos.Create(dmBase.darEstructuraDirNormativas); FGestorDocumentos.RootDocumentos := dmBase.darRutaDocumentosNormativas; FGestorDocumentosNuevo := TGestorDocumentos.Create(dmBase.darEstructuraDirNormativas); FGestorDocumentosNuevo.RootDocumentos := dmBase.darRutaDocumentosNormativasNueva; aDataTable.BeforeCancel := BeforeCancel; aDataTable.AfterCancel := AfterCancel; end; destructor TBizObraDataTableRules.Destroy; begin FCliente := NIL; FClienteLink.Free; FContactos := NIL; FContactosLink.Free; FPresupuestos := NIL; FPresupuestosLink.Free; FProyectos := NIL; FProyectosLink.Free; FSelectedRows.Free; //DOCUMENTOS ASOCIADOS FreeAndNil(FGestorDocumentos); FreeAndNil(FGestorDocumentosNuevo); inherited; end; function TBizObraDataTableRules.GetCliente: IBizContacto; begin if not Assigned(FCliente) then FCliente := dmContactos.GetContacto(CODIGOCONTACTO) else if (CODIGOCONTACTO <> FCliente.Codigo) and not (FCliente.DataTable.State in dsEditModes) then dmContactos.GetContacto(FCliente, CODIGOCONTACTO); if not FCliente.DataTable.Active then FCliente.DataTable.Active := True; Result := FCliente; end; function TBizObraDataTableRules.GetContactos: IBizContactosObra; begin Result := FContactos; end; function TBizObraDataTableRules.GetGestorDocumentos: TGestorDocumentos; begin FGestorDocumentos.Directorio := NOMBRE; Result := FGestorDocumentos; end; function TBizObraDataTableRules.GetGestorDocumentosNuevo: TGestorDocumentos; begin FGestorDocumentosNuevo.Directorio := NOMBRE; Result := FGestorDocumentosNuevo; end; function TBizObraDataTableRules.GetPresupuestos: IBizPresupuestosObra; begin Result := FPresupuestos; end; function TBizObraDataTableRules.GetProyectos: IBizProyectosObra; begin Result := FProyectos; end; function TBizObraDataTableRules.GetSelectedRows: TSelectedRowList; begin Result := FSelectedRows; end; procedure TBizObraDataTableRules.OnNewRecord(Sender: TDADataTable); begin inherited; CODIGOEMPRESA := dmBase.CodigoEmpresa; CODIGO := dmObras.getCodigoObra; USUARIO := dmBase.Usuario; FECHAALTA := dmBase.Fecha; NOMBRE := msgLitNombre; TIPO := TIPO_NUEVA; APLICAHONORARIOS := APLICA_INICIALES; TOTALPRESUPUESTOSINI := 0; TOTALPRESUPUESTOSFIN := 0; end; procedure TBizObraDataTableRules.OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin inherited; Action := daAbort; if (Pos(AUF_HAVEVALUE, Error.Message) > 0) then begin if (Pos('contacto', Error.Message) > 0) then MessageBox(0, PChar(msgLitClienteObligatorio), 'Atención', MB_ICONWARNING or MB_OK); if (Pos('nombre', Error.Message) > 0) then MessageBox(0, PChar(msgLitNombreObligatorio), 'Atención', MB_ICONWARNING or MB_OK); end else raise Error; end; procedure TBizObraDataTableRules.SetCliente(const Value:IBizContacto); var bEnEdicion : Boolean; begin bEnEdicion := (DataTable.State in dsEditModes); if not bEnEdicion then Edit; FCliente := Value; if Assigned(FCliente) then begin CODIGOCONTACTO := FCliente.CODIGO; Post; if bEnEdicion then Edit; end end; procedure TBizObraDataTableRules.SetContactos(const Value: IBizContactosObra); begin FContactos := Value; FContactosLink.DataTable := Self.DataTable; FContactos.DataTable.MasterSource := FContactosLink; end; procedure TBizObraDataTableRules.SetGestorDocumentos(Value: TGestorDocumentos); begin FGestorDocumentos := Value; end; procedure TBizObraDataTableRules.SetGestorDocumentosNuevo(Value: TGestorDocumentos); begin FGestorDocumentosNuevo := Value; end; procedure TBizObraDataTableRules.SetPresupuestos(const Value: IBizPresupuestosObra); begin FPresupuestos := Value; FPresupuestosLink.DataTable := Self.DataTable; FPresupuestos.DataTable.MasterSource := FPresupuestosLink; end; procedure TBizObraDataTableRules.SetProyectos(const Value: IBizProyectosObra); begin FProyectos := Value; FProyectosLink.DataTable := Self.DataTable; FProyectos.DataTable.MasterSource := FProyectosLink; end; procedure TBizObraDataTableRules.Show; begin ShowEditor(IBizObra, Self, etItem); end; procedure TBizObraDataTableRules.ShowApplyUpdateFailed(const Error: EDAApplyUpdateFailed); begin if (Pos(AUF_FKVIOLATION, Error.Message) > 0) then MessageBox(0, PChar(msgErrorObraAsociada), PChar(msgAtencion), MB_ICONWARNING or MB_OK); end; { TBizFecIniFinFieldRules } { ************************** TBizFecIniFinFieldRules ************************** } procedure TBizFecIniFinFieldRules.OnChange(Sender: TDACustomField); var AObj : IBizFechIniFin; AFechaIni: TDAField; AFechaFin: TDAField; begin inherited; if Supports(DataTable, IBizFechIniFin, AObj) then begin AFechaIni := AObj.DataTable.FindField(fld_ObrasFECHAINIOBR); AFechaFin := AObj.DataTable.FindField(fld_ObrasFECHAFINOBR); if not VarIsNull(AFechaIni.AsVariant) and not VarIsNull(AFechaFin.AsVariant) then if CompFec(AFechaIni.AsDateTime, AFechaFin.AsDateTime) = 1 then begin Showmessage(msgErrorFechaIniFin); Sender.FocusControl; end; end; end; { TBizContactosObraDataTableRules } { ************************** TBizContactosObraDataTableRules ************************** } procedure TBizContactosObraDataTableRules.AppendContactos(AContactos: IBizContacto); var CadenaClaves: String; ListaValoresClave: TStringList; begin if not AContactos.DataTable.Active then AContactos.DataTable.Active := True; CadenaClaves := fld_ContactosObraCODIGOOBRA; CadenaClaves := CadenaClaves + ';' + fld_ContactosObraCODIGOCONTACTO; ListaValoresClave := TStringList.Create; Self.DataTable.DisableControls; ShowHourglassCursor; try with AContactos do begin DataTable.First; while not EOF do begin //Por cada elemento a añadir lo buscamos por si ya estuviese añadido Self.First; ListaValoresClave.Clear; ListaValoresClave.Add(IntToStr(Self.Obra.CODIGO)); ListaValoresClave.Add(IntToStr(CODIGO)); if Self.Locate(CadenaClaves, getArrList(ListaValoresClave), []) then begin HideHourglassCursor; MessageBox(0, PChar(NOMBRE + msgLitContactoObraAnadido), 'Atención', MB_ICONWARNING or MB_OK); ShowHourglassCursor; end else begin Self.Append; Self.CODIGOOBRA := Self.Obra.CODIGO; Self.CODIGOCONTACTO := CODIGO; Self.NOMBRE := NOMBRE; Self.CATEGORIAS := LISTACATEGORIAS; Self.Post; end; Next; end; end; finally FreeAndNil(ListaValoresClave); Self.DataTable.EnableControls; HideHourglassCursor; end; end; destructor TBizContactosObraDataTableRules.Destroy; begin FObra := Nil; FContacto := Nil; FPresupuestos := Nil; inherited; end; function TBizContactosObraDataTableRules.GetContacto: IBizContacto; begin if not Assigned(FContacto) then FContacto := dmContactos.GetContacto(CODIGOCONTACTO) else if (CODIGOCONTACTO <> FContacto.Codigo) and not (FContacto.DataTable.State in dsEditModes) then dmContactos.GetContacto(FContacto, CODIGOCONTACTO); if not FContacto.DataTable.Active then FContacto.DataTable.Active := True; Result := FContacto; end; function TBizContactosObraDataTableRules.GetObra: IBizObra; begin Result := FObra; end; function TBizContactosObraDataTableRules.GetPresupuestos: IBizPresupuestosObra; begin Result:= FPresupuestos; end; procedure TBizContactosObraDataTableRules.SetContacto(const Value: IBizContacto); var bEnEdicion : Boolean; begin bEnEdicion := (DataTable.State in dsEditModes); if not bEnEdicion then Edit; FContacto := Value; if Assigned(FContacto) then begin CODIGOCONTACTO := FContacto.CODIGO; Post; if bEnEdicion then Edit; end end; procedure TBizContactosObraDataTableRules.SetObra(const Value: IBizObra); begin FObra := Value; end; procedure TBizContactosObraDataTableRules.SetPresupuestos(const Value: IBizPresupuestosObra); begin FPresupuestos := value; end; procedure TBizContactosObraDataTableRules.Show; begin Self.Presupuestos.DataTable.Filter := fld_PresupuestosObraCODIGOCONTACTO + ' = ' + IntTostr(Self.CODIGOCONTACTO); Self.Presupuestos.DataTable.Filtered := True; ShowEditor(IBizContactosObra, Self, etItem); Self.Presupuestos.DataTable.Filter := ''; Self.Presupuestos.DataTable.Filtered := False; end; { TBizPresupuestosDataTableRules } { ************************** TBizPresupuestosDataTableRules ************************** } constructor TBizPresupuestosDataTableRules.Create(aDataTable: TDADataTable); begin inherited; FSelectedRows := TSelectedRowList.Create(aDataTable); end; destructor TBizPresupuestosDataTableRules.Destroy; begin FObra := NIL; FContacto := NIL; FSelectedRows.Free; inherited; end; function TBizPresupuestosDataTableRules.GetSelectedRows: TSelectedRowList; begin Result := FSelectedRows; end; procedure TBizPresupuestosDataTableRules.OnNewRecord(Sender: TDADataTable); begin inherited; CODIGOOBRA := Self.Obra.CODIGO; CODIGO := dmObras.getCodigoPresupuesto; USUARIO := dmBase.Usuario; FECHAALTA := dmBase.Fecha; FECHA := dmBase.Fecha; TIPO := TIPO_OBRA; APLICARETENCION := CTE_NO_APLICARET; DESCRIPCION := msgLitNombrePre; end; procedure TBizPresupuestosDataTableRules.OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin inherited; Action := daAbort; if (Pos(AUF_HAVEVALUE2, Error.Message) > 0) then begin MessageBox(0, PChar(msgLitNombrePreObligatorio), 'Atención', MB_ICONWARNING or MB_OK); Self.DataTable.FieldByName(fld_PresupuestosObraDESCRIPCION).FocusControl end else if (Pos(AUF_HAVEVALUE, Error.Message) > 0) then begin if (Pos('contacto', Error.Message) > 0) then MessageBox(0, PChar(msgLitNombreContactoPreObligatorio), 'Atención', MB_ICONWARNING or MB_OK); end else raise Error; end; procedure TBizPresupuestosDataTableRules.ShowApplyUpdateFailed(const Error: EDAApplyUpdateFailed); begin if (Pos(AUF_FKVIOLATION, Error.Message) > 0) then MessageBox(0, PChar(msgErrorPresupuestoAsociado), PChar(msgAtencion), MB_ICONWARNING or MB_OK); end; procedure TBizPresupuestosDataTableRules.Show; begin ShowEditor(IBizPresupuestosObra, Self, etItem); end; function TBizPresupuestosDataTableRules.GetContacto: IBizContacto; begin if not Assigned(FContacto) then FContacto := dmContactos.GetContacto(CODIGOCONTACTO) else if (CODIGOCONTACTO <> FContacto.Codigo) and not (FContacto.DataTable.State in dsEditModes) then dmContactos.GetContacto(FContacto, CODIGOCONTACTO); if not FContacto.DataTable.Active then FContacto.DataTable.Active := True; Result := FContacto; end; procedure TBizPresupuestosDataTableRules.SetContacto(const Value: IBizContacto); var bEnEdicion : Boolean; begin bEnEdicion := (DataTable.State in dsEditModes); if not bEnEdicion then Edit; FContacto := Value; if Assigned(FContacto) then begin CODIGOCONTACTO := FContacto.CODIGO; NOMBRE := FContacto.NOMBRE; // Post; //No quitar, se posiciona en el primero if bEnEdicion then Edit; end end; function TBizPresupuestosDataTableRules.GetObra: IBizObra; begin Result := FObra; end; procedure TBizPresupuestosDataTableRules.SetObra(const Value: IBizObra); begin FObra := Value; end; { TBizRetencionFieldRules } { ************************** TBizRetencionFieldRules ************************** } procedure TBizRetencionFieldRules.OnChange(Sender: TDACustomField); var AObj: IBizPresupuestosObra; begin inherited; if Supports(DataTable, IBizRetencion, AObj) then CalcularImporteRetencion(AObj.DataTable); end; { TBizPresupuestoFinFieldRules } procedure TBizPresupuestoFinFieldRules.OnChange(Sender: TDACustomField); var AObj: IBizPresupuestosObra; begin inherited; if Supports(DataTable, IBizPresupuestoFin, AObj) then CalcularImporteRetencion(AObj.DataTable); end; { TBizCalculoHonorariosFieldRules } procedure TBizCalculoHonorariosFieldRules.OnChange(Sender: TDACustomField); var AObj: IBizPresupuestosObra; begin inherited; if Supports(DataTable, IBizCalculoHonorarios, AObj) then CalcularHonorarios(AObj.DataTable); end; procedure TBizPresupuestosDataTableRules.AfterPost(DataTable: TDADataTable); begin inherited; CalcularTotalPresupuestos(DataTable); end; procedure TBizPresupuestosDataTableRules.AfterDelete(DataTable: TDADataTable); begin inherited; CalcularTotalPresupuestos(DataTable); end; { TBizProyectosDataTableRules } procedure TBizProyectosDataTableRules.AfterCancel(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.Directorio := DESCRIPCION; GestorDocumentosNuevo.Directorio := DESCRIPCION; end; procedure TBizProyectosDataTableRules.BeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); begin // ValidarProyecto(Self); end; procedure TBizProyectosDataTableRules.BeforeCancel(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.procesarCancelTable; GestorDocumentosNuevo.procesarCancelTable; end; procedure TBizProyectosDataTableRules.BeforeDelete(Sender: TDADataTable); begin inherited; //DOCUMENTOS ASOCIADOS GestorDocumentos.procesarDeleteTable; GestorDocumentosNuevo.procesarDeleteTable; end; constructor TBizProyectosDataTableRules.Create(aDataTable: TDADataTable); begin inherited; FSelectedRows := TSelectedRowList.Create(aDataTable); aDataTable.OnBeforeApplyUpdates := BeforeApplyUpdates; //DOCUMENTOS ASOCIADOS FGestorDocumentos := TGestorDocumentos.Create(dmBase.darEstructuraDirProyectos); FGestorDocumentos.RootDocumentos := dmBase.darRutaDocumentosProyectos; FGestorDocumentosNuevo := TGestorDocumentos.Create(dmBase.darEstructuraDirProyectos); FGestorDocumentosNuevo.RootDocumentos := dmBase.darRutaDocumentosProyectosNueva; aDataTable.BeforeCancel := BeforeCancel; aDataTable.AfterCancel := AfterCancel; end; destructor TBizProyectosDataTableRules.Destroy; begin FObra := NIL; FSelectedRows.Free; //DOCUMENTOS ASOCIADOS FreeAndNil(FGestorDocumentos); FreeAndNil(FGestorDocumentosNuevo); inherited; end; function TBizProyectosDataTableRules.GetGestorDocumentos: TGestorDocumentos; begin FGestorDocumentos.Directorio := DESCRIPCION; Result := FGestorDocumentos; end; function TBizProyectosDataTableRules.GetGestorDocumentosNuevo: TGestorDocumentos; begin FGestorDocumentosNuevo.Directorio := DESCRIPCION; Result := FGestorDocumentosNuevo; end; function TBizProyectosDataTableRules.GetObra: IBizObra; begin Result := FObra; end; function TBizProyectosDataTableRules.GetSelectedRows: TSelectedRowList; begin Result := FSelectedRows; end; procedure TBizProyectosDataTableRules.OnNewRecord(Sender: TDADataTable); begin inherited; CODIGOOBRA := Self.Obra.CODIGO; CODIGO := dmObras.getCodigoProyecto; DESCRIPCION := msgLitNombrePro + IntToStr(CODIGO); TIPO := TIPO_ANTEPROYECTO; end; procedure TBizProyectosDataTableRules.OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin inherited; // end; procedure TBizProyectosDataTableRules.SetGestorDocumentos(Value: TGestorDocumentos); begin FGestorDocumentos := Value; end; procedure TBizProyectosDataTableRules.SetGestorDocumentosNuevo(Value: TGestorDocumentos); begin FGestorDocumentosNuevo := Value; end; procedure TBizProyectosDataTableRules.SetObra(const Value: IBizObra); begin FObra := Value; end; procedure TBizProyectosDataTableRules.Show; begin ShowEditor(IBizProyectosObra, Self, etItem); end; procedure TBizProyectosDataTableRules.ShowApplyUpdateFailed( const Error: EDAApplyUpdateFailed); begin if (Pos(AUF_FKVIOLATION, Error.Message) > 0) then MessageBox(0, PChar(msgErrorProyectoAsociado), PChar(msgAtencion), MB_ICONWARNING or MB_OK); end; procedure TBizPresupuestosDataTableRules.AdjuntarContacto; var AContacto : IBizContacto; begin AContacto := dmContactos.GetContactos; try if AContacto.ShowForSelect = mrOK then begin AContacto := dmContactos.GetItemsSeleccionados(AContacto); Self.Obra.Contactos.AppendContactos(AContacto); Self.CODIGOCONTACTO := AContacto.CODIGO; end; finally AContacto := NIL; end; end; {function TBizObraDataTableRules.ShowForSelect: TModalResult; begin Result := ShowEditor(IBizObra, Self, etItems); //etSelectItem); end;} initialization RegisterDataTableRules(BIZ_OBRA, TBizObraDataTableRules); RegisterDataTableRules(BIZ_CONTACTOOBRA, TBizContactosObraDataTableRules); RegisterDataTableRules(BIZ_PRESUPUESTOOBRA, TBizPresupuestosDataTableRules); RegisterDataTableRules(BIZ_PROYECTOSOBRA, TBizProyectosDataTableRules); RegisterFieldRules(BIZ_FECINIFIN, TBizFecIniFinFieldRules); RegisterFieldRules(BIZ_CALCULOHONORARIOS, TBizCalculoHonorariosFieldRules); RegisterFieldRules(BIZ_RETENCION, TBizRetencionFieldRules); RegisterFieldRules(BIZ_PRESUPUESTOFIN, TBizPresupuestoFinFieldRules); finalization end.