unit uBizPagos; interface uses uDAInterfaces, uDADataTable, schPagosClient_Intf, Classes, DBGrids, uDBSelectionList, DB, uExceptions, Controls, uBizContacto, uBizInformesBase; Const BIZ_PAGOSCLIENTE = 'Client.PagosCliente'; BIZ_PAGOSPROVEEDOR = 'Client.PagosProveedor'; type IBizPagos = interface(IPagos) ['{39E062C3-C59D-4E98-87A8-6C599B78CB2D}'] function Show: TModalResult; procedure ShowAll; procedure Preview; procedure Print; function GetContacto: IBizContacto; procedure SetContacto(Value: IBizContacto); property Contacto: IBizContacto read GetContacto write SetContacto; end; IBizPagosProveedor = interface(IBizPagos) ['{DBF8F6EE-84F4-49B7-B57D-E8811EF66FC0}'] end; IBizPagosCliente = interface(IBizPagos) ['{E587258D-ED30-4D76-AC43-4E0E6B00059A}'] end; TBizPagosDataTableRules = class(TPagosDataTableRules, IBizPagos, IApplyUpdateFailedException, ISelectedRowList, IBizInformesAware) private FContacto: IBizContacto; FSelectedRows : TSelectedRowList; procedure BeforeApplyUpdates(Sender: TDADataTable; const Delta: IDADelta); procedure anadirAsiento; protected function GetContacto: IBizContacto; procedure SetContacto(Value: IBizContacto); function GetSelectedRows : TSelectedRowList; virtual; procedure OnNewRecord(Sender: TDADataTable); override; procedure ShowApplyUpdateFailed (const Error: EDAApplyUpdateFailed); virtual; procedure BeforeDelete(Sender: TDADataTable); override; public property Contacto: IBizContacto read GetContacto write SetContacto; property SelectedRows : TSelectedRowList read GetSelectedRows; constructor Create(aDataTable: TDADataTable); override; destructor Destroy; override; function Show: TModalResult; virtual; procedure ShowAll; virtual; procedure Preview; procedure Print; virtual; end; TBizPagosProveedor = class(TBizPagosDataTableRules, IBizPagosProveedor) private procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); override; public function Show: TModalResult; override; end; TBizPagosCliente = class(TBizPagosDataTableRules, IBizPagosCliente) private procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); override; public function Show: TModalResult; override; end; procedure ValidarPago (const APago : IBizPagos); implementation uses Windows, Forms, Dialogs, uDACDSDataTable, SysUtils, Variants, DateUtils, uDataModuleBase, uDataModuleUsuarios, uEditorUtils, uDataModulePagos, uDataModuleContactos, uDataModuleAsientos, uBizAsientos; procedure ValidarPago (const APago : IBizPagos); begin if APago.Cuenta = 0 then raise Exception.Create('El pago debe tener una cuenta destino'); end; { TBizPagosDataTableRules } { ************************** TBizPagosDataTableRules ************************** } procedure TBizPagosDataTableRules.OnNewRecord(Sender: TDADataTable); begin inherited; CODIGOEMPRESA := dmBase.CodigoEmpresa; USUARIO := dmUsuarios.LoginInfo.UserID; FECHAALTA := Date; FECHAPAGO := Date; IMPORTE := 0; CODIGO := dmPagos.GetNextAutoinc; end; function TBizPagosDataTableRules.Show: TModalResult; begin Result := mrCancel; end; procedure TBizPagosDataTableRules.Preview; begin dmPagos.Preview(Self.CODIGO); end; procedure TBizPagosDataTableRules.ShowApplyUpdateFailed(const Error: EDAApplyUpdateFailed); begin if (Pos(AUF_FKVIOLATION, Error.Message) > 0) then MessageBox(0, 'No se puede borrar este almacén porque tiene articulos o está asociado al destino de algún pedido', 'Atención', MB_ICONWARNING or MB_OK); end; constructor TBizPagosDataTableRules.Create(aDataTable: TDADataTable); begin inherited; FContacto := NIL; FSelectedRows := TSelectedRowList.Create(aDataTable); aDataTable.OnBeforeApplyUpdates := BeforeApplyUpdates; end; destructor TBizPagosDataTableRules.Destroy; begin FContacto := NIL; FSelectedRows.Free; inherited; end; procedure TBizPagosDataTableRules.ShowAll; begin // ShowEditor(IBizProveedor, Self, etItems); end; procedure TBizPagosDataTableRules.BeforeApplyUpdates(Sender: TDADataTable; const Delta: IDADelta); var i, x: Integer; begin for i := 0 to Delta.Count - 1 do case Delta.Changes[i].ChangeType of ctInsert, ctUpdate: begin ValidarPago(Self); //Solo añadiremos el asiento si inserta un pago nuevo //o modifica el pago el campo cuenta if (Delta.Changes[i].OldValueByName[fld_PagosCUENTA] <> Delta.Changes[i].NewValueByName[fld_PagosCUENTA]) then anadirAsiento; end; // ctDelete : end; end; procedure TBizPagosDataTableRules.BeforeDelete(Sender: TDADataTable); begin inherited; { if not dmPagos.PuedoEliminarAlmacen(CODIGO) then raise Exception.Create('No se puede borrar este almacén porque tiene articulos o está asociado al destino de algún pedido'); } end; function TBizPagosDataTableRules.GetContacto: IBizContacto; begin if not Assigned(FContacto) then begin if Supports(DataTable, IBizPagosCliente) then FContacto := dmContactos.GetCliente(CODIGOCONTACTO) else if Supports(DataTable, IBizPagosProveedor) then FContacto := dmContactos.GetProveedor(CODIGOCONTACTO) else raise Exception.Create('Interfaz del pago no soportada'); end 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 TBizPagosDataTableRules.SetContacto(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; function TBizPagosDataTableRules.GetSelectedRows: TSelectedRowList; begin Result := FSelectedRows; end; { TBizPagosCliente } procedure TBizPagosCliente.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, 'Debe indicar el cliente', 'Atención', MB_ICONWARNING or MB_OK) else raise Error; end else raise Error; end; function TBizPagosCliente.Show: TModalResult; begin Result := inherited Show; Result := ShowEditor(IBizPagosCliente, Self, etItem); end; { TBizPagosProveedor } procedure TBizPagosProveedor.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, 'Debe indicar el proveedor', 'Atención', MB_ICONWARNING or MB_OK) else raise Error; end else raise Error; end; function TBizPagosProveedor.Show: TModalResult; begin Result := inherited Show; Result := ShowEditor(IBizPagosProveedor, Self, etItem); end; procedure TBizPagosDataTableRules.Print; begin dmPagos.Print(Self.CODIGO); end; procedure TBizPagosDataTableRules.anadirAsiento; var DatosAsiento : TDatosAsiento; Cadena: String; begin if (Application.MessageBox('¿Desea añadir una entrada en la cuenta asociada al cobro/pago?', 'Atención', MB_YESNO) = IDYES) then begin DatosAsiento := TDatosAsiento.Create; with DatosAsiento do begin CodigoCuenta := Self.CUENTA; FechaAsiento := Self.FECHAPAGO; CodigoPago := Self.CODIGO; if Supports(DataTable, IBizPagosCliente) then begin if Self.IMPORTE < 0 then Cadena := '[Abono de cliente: ' + Self.CONTACTO.NOMBRE + ']: ' else Cadena := '[Cobro de cliente: ' + Self.CONTACTO.NOMBRE + ']: '; Descripcion := Cadena + Self.DESCRIPCION; Importe := Self.IMPORTE; end else if Supports(DataTable, IBizPagosProveedor) then begin if Self.IMPORTE < 0 then Cadena := '[Abono de proveedor: ' + Self.CONTACTO.NOMBRE + ']: ' else Cadena := '[Pago a proveedor: ' + Self.CONTACTO.NOMBRE + ']: '; Descripcion := Cadena + Self.DESCRIPCION; Importe := (-1) * Self.IMPORTE; end else raise Exception.Create('Interfaz del pago no soportada'); end; dmAsientos.anadirAsiento(DatosAsiento); DatosAsiento.Free; end; end; initialization RegisterDataTableRules(BIZ_PAGOSPROVEEDOR, TBizPagosProveedor); RegisterDataTableRules(BIZ_PAGOSCLIENTE, TBizPagosCliente); finalization end.