git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES/trunk@4 b68bf8ae-e977-074f-a058-3cfd71dd8f45
250 lines
6.9 KiB
ObjectPascal
250 lines
6.9 KiB
ObjectPascal
{
|
|
===============================================================================
|
|
Copyright (©) 2001. 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: 01-10-2001
|
|
Versión actual: 1.0.3
|
|
Fecha versión actual: 28-12-2002
|
|
===============================================================================
|
|
Modificaciones:
|
|
|
|
Fecha Comentarios
|
|
---------------------------------------------------------------------------
|
|
03-10-2001 Quitar refresco del grid, ordenación por click en titulo
|
|
|
|
05-11-2001 Quitar la cacheUpdates, y hacer bloqueo para los demás usuarios
|
|
|
|
07-04-2002 Se ha adaptado a una unica transacción.
|
|
|
|
09-05-2002 Cambio de grid en lugar de utilizar UltimDBGrid, utilizaremos dxDBGrid.
|
|
|
|
28-12-2002 Se establece el campo DESCRIPCION como clave primaria y se captura la
|
|
excepcion (no se permitirán formas de pago con misma descripcion), arreglo de
|
|
el boton cancelar de el mensaje "esta seguro que desea eliminar"
|
|
|
|
===============================================================================
|
|
}
|
|
|
|
unit FormasPago;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
RDXDBFRAME, RdxBotones, ExtCtrls, RdxPaneles, RdxBarras, RdxTitulos,
|
|
RXDBCtrl, IBCustomDataSet, Db, StdCtrls, DBTables, dxCntner, dxTL,
|
|
dxDBCtrl, dxDBGrid;
|
|
|
|
type
|
|
TfrFormasPago = class(TRdxDBFrame)
|
|
BarraProveedores: TRdxBarraSuperior;
|
|
dsFormasPago: TDataSource;
|
|
brDoble: TRdxBarraInferior;
|
|
bAceptar: TRdxBoton;
|
|
bCancelar: TRdxBoton;
|
|
RdxPanel1: TRdxPanel;
|
|
RdxPanel4: TRdxPanel;
|
|
RdxPanel3: TRdxPanel;
|
|
bAnadir: TRdxBoton;
|
|
bEliminar: TRdxBoton;
|
|
gridFormasPago: TdxDBGrid;
|
|
procedure bAnadirClick(Sender: TObject);
|
|
procedure bEliminarClick(Sender: TObject);
|
|
procedure bAceptarClick(Sender: TObject);
|
|
procedure bCancelarClick(Sender: TObject);
|
|
private
|
|
TablaFormasPago : TIBDataSet;
|
|
procedure ActualizarBotones;
|
|
protected
|
|
procedure ActivarModoAnadir; override;
|
|
public
|
|
constructor Create (AOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
procedure AppException(Sender: TObject; E: Exception);
|
|
procedure FormasPagoAfterInsert(DataSet: TDataSet);
|
|
property BaseDatos;
|
|
property Transaccion;
|
|
end;
|
|
|
|
var
|
|
frFormasPago: TfrFormasPago;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
{ TfrFormasPago }
|
|
|
|
uses
|
|
Tipos, BaseDatos, TablaFormasPago, IB, Mensajes, StrFunc,
|
|
Excepciones, IBErrorCodes, Configuracion, Literales;
|
|
|
|
constructor TfrFormasPago.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
Application.OnException := AppException;
|
|
Entidad := entFormasPago;
|
|
ConfigurarFrame(Self, Self.Entidad);
|
|
|
|
BaseDatos := dmBaseDatos.BD;
|
|
Transaccion := dmBaseDatos.Transaccion;
|
|
TablaFormasPago := TIBDataSet.Create(Self);
|
|
TablaFormasPago.AfterInsert := FormasPagoAfterInsert;
|
|
|
|
dsFormasPago.DataSet := TablaFormasPago;
|
|
|
|
with TablaFormasPago do
|
|
begin
|
|
Database := BaseDatos;
|
|
Transaction := Transaccion;
|
|
InsertSQL.Assign(dmTablaFormasPago.sqlInsertar);
|
|
ModifySQL.Assign(dmTablaFormasPago.sqlModificar);
|
|
DeleteSQL.Assign(dmTablaFormasPago.sqlEliminar);
|
|
SelectSQL.Assign(dmTablaFormasPago.sqlConsultar);
|
|
end;
|
|
end;
|
|
|
|
destructor TfrFormasPago.Destroy;
|
|
begin
|
|
Application.OnException := NIL;
|
|
TablaFormasPago.Close;
|
|
TablaFormasPago.UnPrepare;
|
|
TablaFormasPago.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrFormasPago.bAnadirClick(Sender: TObject);
|
|
begin
|
|
TablaFormasPago.Append;
|
|
gridFormasPago.SetFocus;
|
|
end;
|
|
|
|
procedure TfrFormasPago.bEliminarClick(Sender: TObject);
|
|
begin
|
|
if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then
|
|
Exit;
|
|
try
|
|
if TablaFormasPago.RecordCount = 0
|
|
{ Hacemos un cancel de la tabla por si el registro actual estuviera
|
|
recien creado }
|
|
then TablaFormasPago.Cancel
|
|
else TablaFormasPago.Delete;
|
|
except
|
|
on E : EIBError do
|
|
TratarExcepcion(E);
|
|
on E : Exception do
|
|
TratarExcepcion(E);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrFormasPago.bAceptarClick(Sender: TObject);
|
|
begin
|
|
if TablaFormasPago.State in [dsEdit, dsInsert] then
|
|
TablaFormasPago.Post;
|
|
Commit;
|
|
CloseFrame;
|
|
end;
|
|
|
|
procedure TfrFormasPago.bCancelarClick(Sender: TObject);
|
|
begin
|
|
try
|
|
Rollback;
|
|
CloseFrame;
|
|
except
|
|
on E : EIBError do
|
|
TratarExcepcion(E);
|
|
on E : Exception do
|
|
TratarExcepcion(E);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrFormasPago.FormasPagoAfterInsert(DataSet: TDataSet);
|
|
begin
|
|
DataSet.FieldByName('DB_KEY').AsString := '-';
|
|
end;
|
|
|
|
procedure TfrFormasPago.AppException(Sender: TObject; E: Exception);
|
|
begin
|
|
if E.Message = 'Field ''DESCRIPCION'' must have a value' then begin
|
|
VerMensaje(msgForPagFaltaDes);
|
|
TablaFormasPago.Edit;
|
|
end
|
|
else if E.Message = 'violation of PRIMARY or UNIQUE KEY constraint "PK_FORMASPAGO" on table "FORMASPAGO"' then begin
|
|
VerMensajeFmt(msgForPagRepetida, [UpperCase(TablaFormasPago.FieldByName('DESCRIPCION').AsString)]);
|
|
TablaFormasPago.Edit;
|
|
end
|
|
else
|
|
VerMensaje(E.Message);
|
|
end;
|
|
|
|
procedure TfrFormasPago.ActualizarBotones;
|
|
begin
|
|
if BaseDatos.IsReadOnly then
|
|
begin
|
|
bAnadir.Enabled := False;
|
|
bEliminar.Enabled := False;
|
|
gridFormasPago.Enabled := False;
|
|
end
|
|
else begin
|
|
bAnadir.Enabled := True;
|
|
bEliminar.Enabled := True;
|
|
gridFormasPago.Enabled := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrFormasPago.ActivarModoAnadir;
|
|
begin
|
|
try
|
|
with TablaFormasPago do
|
|
begin
|
|
Prepare;
|
|
Open;
|
|
ActualizarBotones;
|
|
|
|
if RecordCount = 0 then
|
|
begin
|
|
Edit;
|
|
FieldByName('DESCRIPCION').AsString := ' ';
|
|
Post;
|
|
Delete
|
|
end
|
|
else
|
|
begin
|
|
Edit;
|
|
Post;
|
|
end;
|
|
end;
|
|
dmTablaFormasPago.InicializarGridFormasPago(gridFormasPago);
|
|
except
|
|
on E : EIBError do
|
|
begin
|
|
case E.IBErrorCode of
|
|
isc_lock_conflict : begin
|
|
Rollback;
|
|
VerMensaje(msgForPagTablaBloq);
|
|
CloseFrame;
|
|
end
|
|
else begin
|
|
Rollback;
|
|
TratarExcepcion(E);
|
|
end;
|
|
end;
|
|
end;
|
|
on E : Exception do begin
|
|
Rollback;
|
|
TratarExcepcion(E);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|