{ =============================================================================== 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: 21-10-2002 Versión actual: 1.0.0 Fecha versión actual: 21-10-2002 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit TiposCliente; 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; type TfrTiposCliente = class(TRdxDBFrame) BarraTiposCliente: TRdxBarraSuperior; dsTiposCliente: TDataSource; brDoble: TRdxBarraInferior; bAceptar: TRdxBoton; bCancelar: TRdxBoton; pnlCuerpo: TRdxPanel; pnlGrid: TRdxPanel; pnlBotones: TRdxPanel; bAnadir: TRdxBoton; bEliminar: TRdxBoton; gridTiposCliente: TdxDBGrid; procedure bAnadirClick(Sender: TObject); procedure bEliminarClick(Sender: TObject); procedure bAceptarClick(Sender: TObject); procedure bCancelarClick(Sender: TObject); private TablaTiposCliente : TIBDataSet; procedure ActualizarBotones; protected procedure ActivarModoAnadir; override; public constructor Create (AOwner : TComponent); override; destructor Destroy; override; published procedure AppException(Sender: TObject; E: Exception); procedure TiposClienteAfterInsert(DataSet: TDataSet); property BaseDatos; property Transaccion; end; var frTiposCliente: TfrTiposCliente; implementation {$R *.DFM} { TfrTiposCliente } uses Tipos, BaseDatos, TablaTiposCliente, IB, Mensajes, StrFunc, Excepciones, Configuracion, IBErrorCodes, Literales; constructor TfrTiposCliente.Create(AOwner: TComponent); begin inherited Create(AOwner); Application.OnException := AppException; Entidad := entFamilias; ConfigurarFrame(Self, Self.Entidad); BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaTiposCliente := TIBDataSet.Create(Self); TablaTiposCliente.AfterInsert := TiposClienteAfterInsert; dsTiposCliente.DataSet := TablaTiposCliente; with TablaTiposCliente do begin Database := BaseDatos; Transaction := Transaccion; InsertSQL.Assign(dmTablaTiposCliente.sqlInsertar); ModifySQL.Assign(dmTablaTiposCliente.sqlModificar); DeleteSQL.Assign(dmTablaTiposCliente.sqlEliminar); SelectSQL.Assign(dmTablaTiposCliente.sqlConsultar); end; end; destructor TfrTiposCliente.Destroy; begin Application.OnException := NIL; TablaTiposCliente.Close; TablaTiposCliente.UnPrepare; TablaTiposCliente.Free; inherited; end; procedure TfrTiposCliente.bAnadirClick(Sender: TObject); begin TablaTiposCliente.Append; gridTiposCliente.SetFocus; end; procedure TfrTiposCliente.bEliminarClick(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) = IDNO) then Exit; try if TablaTiposCliente.RecordCount = 0 { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } then TablaTiposCliente.Cancel else TablaTiposCliente.Delete; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrTiposCliente.bAceptarClick(Sender: TObject); begin if TablaTiposCliente.State in [dsEdit, dsInsert] then TablaTiposCliente.Post; Commit; CloseFrame; end; procedure TfrTiposCliente.bCancelarClick(Sender: TObject); begin try Rollback; CloseFrame; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrTiposCliente.TiposClienteAfterInsert(DataSet: TDataSet); begin DataSet.FieldByName('DB_KEY').AsString := '-'; end; procedure TfrTiposCliente.AppException(Sender: TObject; E: Exception); begin if E.Message = 'Field ''DESCRIPCION'' must have a value' then VerMensaje(msgTipCliFaltaDes) else VerMensaje(E.Message); end; procedure TfrTiposCliente.ActualizarBotones; begin if BaseDatos.IsReadOnly then begin bAnadir.Enabled := False; bEliminar.Enabled := False; gridTiposCliente.Enabled := False; end else begin bAnadir.Enabled := True; bEliminar.Enabled := True; gridTiposCliente.Enabled := True; end; end; procedure TfrTiposCliente.ActivarModoAnadir; begin try with TablaTiposCliente do begin Prepare; Open; ActualizarBotones; if RecordCount = 0 then begin Edit; FieldByName('DESCRIPCION').AsString := ' '; Post; Delete end else begin Edit; Post; end; end; dmTablaTiposCliente.InicializarGridTiposCliente(gridTiposCliente); except on E : EIBError do begin case E.IBErrorCode of isc_lock_conflict : begin Rollback; VerMensaje(msgTipCliTablaBloq); CloseFrame; end else begin Rollback; TratarExcepcion(E); end; end; end; on E : Exception do begin Rollback; TratarExcepcion(E); end; end; end; end.