AlonsoYSal_FactuGES/Modulos/Pagos/Reglas/uBizPagos.pas

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; virtual;
    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<61>n porque tiene articulos o est<73> asociado al destino de alg<6C>n pedido', 'Atenci<63>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<61>n porque tiene articulos o est<73> asociado al destino de alg<6C>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<63>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<63>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('<27>Desea a<>adir una entrada en la cuenta asociada al cobro/pago?', 'Atenci<63>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.