{ =============================================================================== Copyright (©) 2002. 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: 04-12-2002 Versión actual: 1.0.0 Fecha versión actual: 04-12-2002 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit Familias; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, RdxBotones, RdxBarras, Grids, DBGrids, RXDBCtrl, ExtCtrls, RdxPaneles, IBCustomDataSet, IBQuery, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxEdit, cxDBData, cxGridLevel, cxClasses, cxControls, cxGridCustomView, Configuracion, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, RdxDBFrame, cxGridCardView, cxGridDBCardView, IB, IBErrorCodes, ActnList, Entidades, cxDataStorage; type TfrFamilias = class(TRdxDBFrame) BarraFamilias: TRdxBarraSuperior; dsFamilias: TDataSource; brDoble: TRdxBarraInferior; bAceptar: TRdxBoton; bCancelar: TRdxBoton; pnlCuerpo: TRdxPanel; pnlBotones: TRdxPanel; bAnadir: TRdxBoton; bEliminar: TRdxBoton; gridFamilias: TcxGrid; gridFamiliasDBTableView1: TcxGridDBTableView; gridFamiliasLevel1: TcxGridLevel; ActionList1: TActionList; actAnadir: TAction; actEliminar: TAction; actAceptar: TAction; actCancelar: TAction; imgSombra: TImage; procedure RdxDBFrameShow(Sender: TObject); procedure actAnadirExecute(Sender: TObject); procedure actEliminarExecute(Sender: TObject); procedure actAceptarExecute(Sender: TObject); procedure actCancelarExecute(Sender: TObject); procedure actAnadirUpdate(Sender: TObject); procedure actEliminarUpdate(Sender: TObject); private TablaFamilias : TIBDataSet; procedure FamiliasOnNewRecord(DataSet: TDataSet); protected procedure ActivarModoAnadir; override; function CambiarEntidad(EntidadAnterior, Entidad : TRdxEntidad): Boolean; override; public constructor Create (AOwner : TComponent); override; destructor Destroy; override; published procedure AppException(Sender: TObject; E: Exception); end; var frFamilias: TfrFamilias; implementation {$R *.DFM} { TfrFamilias } uses BaseDatos, TablaFamilias, Mensajes, Excepciones, Literales; constructor TfrFamilias.Create(AOwner: TComponent); begin inherited Create(AOwner); Entidad := entFamilias; ConfigurarFrame(Self, Entidad); Application.OnException := AppException; BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaFamilias := TIBDataSet.Create(Self); TablaFamilias.OnNewRecord := FamiliasOnNewRecord; 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; bCancelar.Cancel := True; end; destructor TfrFamilias.Destroy; begin Application.OnException := NIL; TablaFamilias.Close; TablaFamilias.UnPrepare; TablaFamilias.Free; inherited; end; procedure TfrFamilias.FamiliasOnNewRecord(DataSet: TDataSet); begin DataSet.FieldByName('CODIGO').AsInteger := dmTablaFamilias.darContadorFamilia; end; procedure TfrFamilias.AppException(Sender: TObject; E: Exception); begin if E.Message = 'Field ''DESCRIPCION'' must have a value' then begin VerMensaje(msgDatosFaltaDescripcionFam); TablaFamilias.Edit; end else if E.Message = 'violation of PRIMARY or UNIQUE KEY constraint "UNQ_FAMILIAS" on table "FAMILIAS"' then begin VerMensajeFmt(msgDatosFamiliaRepetida, [UpperCase(TablaFamilias.FieldByName('DESCRIPCION').AsString)]); TablaFamilias.Edit; end else TratarExcepcion(E); end; procedure TfrFamilias.ActivarModoAnadir; begin try with TablaFamilias do begin Prepare; Open; if RecordCount = 0 then begin Edit; FieldByName('DESCRIPCION').AsString := ' '; Post; Delete end else begin Edit; Post; end; end; dmTablaFamilias.InicializarGridFamilias(gridFamiliasDBTableView1); ActivarEdicionGridDetalles(gridFamilias); except on E : EIBError do begin case E.IBErrorCode of isc_lock_conflict : begin Rollback; VerMensaje(msgDatosTablaFamBloqueada); CloseFrame; end else begin Rollback; TratarExcepcion(E); end; end; end; on E : Exception do begin Rollback; TratarExcepcion(E); end; end; end; procedure TfrFamilias.RdxDBFrameShow(Sender: TObject); begin bCancelar.SetFocus; end; procedure TfrFamilias.actAnadirExecute(Sender: TObject); begin TablaFamilias.Insert; gridFamilias.SetFocus; end; procedure TfrFamilias.actEliminarExecute(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then Exit; try if TablaFamilias.RecordCount = 0 then { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } TablaFamilias.Cancel else TablaFamilias.Delete except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrFamilias.actAceptarExecute(Sender: TObject); begin if TablaFamilias.State in [dsEdit, dsInsert] then TablaFamilias.Post; Commit; CloseFrame; end; procedure TfrFamilias.actCancelarExecute(Sender: TObject); begin try Rollback; CloseFrame; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrFamilias.actAnadirUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not BaseDatos.IsReadOnly; end; procedure TfrFamilias.actEliminarUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not BaseDatos.IsReadOnly; end; function TfrFamilias.CambiarEntidad(EntidadAnterior, Entidad: TRdxEntidad): Boolean; begin inherited CambiarEntidad(EntidadAnterior, Entidad); ConfigurarFrame(Self, Self.Entidad); end; end.