{ =============================================================================== 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 familias con misma descripcion), arreglo de el boton cancelar de el mensaje "esta seguro que desea eliminar" =============================================================================== } unit Familias; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, RDXDBFRAME, RdxBotones, ExtCtrls, RdxPaneles, RdxBarras, RdxTitulos, Grids, DBGrids, RXDBCtrl, IBCustomDataSet, Db, StdCtrls, DBTables, dxCntner, dxTL, dxDBCtrl, dxDBGrid, dxExEdtr; type TfrFamilias = class(TRdxDBFrame) BarraFamilias: TRdxBarraSuperior; dsFamilias: TDataSource; brDoble: TRdxBarraInferior; bAceptar: TRdxBoton; bCancelar: TRdxBoton; pnlCuerpo: TRdxPanel; pnlGrid: TRdxPanel; pnlBotones: TRdxPanel; bAnadir: TRdxBoton; bEliminar: TRdxBoton; gridFamilias: TdxDBGrid; procedure bAnadirClick(Sender: TObject); procedure bEliminarClick(Sender: TObject); procedure bAceptarClick(Sender: TObject); procedure bCancelarClick(Sender: TObject); private TablaFamilias : TIBDataSet; procedure ActualizarBotones; protected procedure ActivarModoAnadir; override; public constructor Create (AOwner : TComponent); override; destructor Destroy; override; published procedure AppException(Sender: TObject; E: Exception); procedure FamiliasAfterInsert(DataSet: TDataSet); property BaseDatos; property Transaccion; end; var frFamilias: TfrFamilias; implementation {$R *.DFM} { TfrFamilias } uses Tipos, BaseDatos, TablaFamilias, IB, Mensajes, StrFunc, Excepciones, IBErrorCodes, Configuracion, Literales; constructor TfrFamilias.Create(AOwner: TComponent); begin inherited Create(AOwner); Application.OnException := AppException; ConfigurarFrame(Self, Self.Entidad); Entidad := entFamilias; BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaFamilias := TIBDataSet.Create(Self); TablaFamilias.AfterInsert := FamiliasAfterInsert; dsFamilias.DataSet := TablaFamilias; with TablaFamilias do begin Database := BaseDatos; Transaction := Transaccion; InsertSQL.Assign(dmTablaFamilias.sqlInsertar); ModifySQL.Assign(dmTablaFamilias.sqlModificar); DeleteSQL.Assign(dmTablaFamilias.sqlEliminar); SelectSQL.Assign(dmTablaFamilias.sqlConsultar); end; end; destructor TfrFamilias.Destroy; begin Application.OnException := NIL; TablaFamilias.Close; TablaFamilias.UnPrepare; TablaFamilias.Free; inherited; end; procedure TfrFamilias.bAnadirClick(Sender: TObject); begin TablaFamilias.Append; gridFamilias.SetFocus; end; procedure TfrFamilias.bEliminarClick(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then Exit; try if TablaFamilias.RecordCount = 0 { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } then TablaFamilias.Cancel else TablaFamilias.Delete; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrFamilias.bAceptarClick(Sender: TObject); begin if TablaFamilias.State in [dsEdit, dsInsert] then TablaFamilias.Post; Commit; CloseFrame; end; procedure TfrFamilias.bCancelarClick(Sender: TObject); begin try Rollback; CloseFrame; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrFamilias.FamiliasAfterInsert(DataSet: TDataSet); begin DataSet.FieldByName('DB_KEY').AsString := '-'; end; procedure TfrFamilias.AppException(Sender: TObject; E: Exception); begin if E.Message = 'Field ''DESCRIPCION'' must have a value' then begin VerMensaje(msgFamFaltaDes); TablaFamilias.Edit; end else if E.Message = 'violation of PRIMARY or UNIQUE KEY constraint "PK_FAMILIAS" on table "FAMILIAS"' then begin VerMensajeFmt(msgFamRepetida, [UpperCase(TablaFamilias.FieldByName('DESCRIPCION').AsString)]); TablaFamilias.Edit; end else VerMensaje(E.Message); end; procedure TfrFamilias.ActualizarBotones; begin if BaseDatos.IsReadOnly then begin bAnadir.Enabled := False; bEliminar.Enabled := False; gridFamilias.Enabled := False; end else begin bAnadir.Enabled := True; bEliminar.Enabled := True; gridFamilias.Enabled := True; end; end; procedure TfrFamilias.ActivarModoAnadir; begin try with TablaFamilias do begin Prepare; Open; ActualizarBotones; if RecordCount = 0 then begin Edit; FieldByName('DESCRIPCION').AsString := ' '; Post; Delete end else begin Edit; Post; end; end; dmTablaFamilias.InicializarGridFamilias(gridFamilias); except on E : EIBError do begin case E.IBErrorCode of isc_lock_conflict : begin Rollback; VerMensaje(msgFamTablaBloq); CloseFrame; end else begin Rollback; TratarExcepcion(E); end; end; end; on E : Exception do begin Rollback; TratarExcepcion(E); end; end; end; end.