{ =============================================================================== Copyright (©) 2007. 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: 03-04-2007 Versión actual: 1.0.0 Fecha versión actual: 03-04-2007 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit Procedencias; 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 TfrProcedencias = class(TRdxDBFrame) BarraProcedencias: TRdxBarraSuperior; dsProcedencias: TDataSource; brDoble: TRdxBarraInferior; bAceptar: TRdxBoton; bCancelar: TRdxBoton; pnlCuerpo: TRdxPanel; pnlBotones: TRdxPanel; bAnadir: TRdxBoton; bEliminar: TRdxBoton; gridProcedencias: TcxGrid; gridProcedenciasDBTableView1: TcxGridDBTableView; gridProcedenciasLevel1: 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 TablaProcedencias : TIBDataSet; procedure ProcedenciasOnNewRecord(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 frProcedencias: TfrProcedencias; implementation {$R *.DFM} { TfrProcedencias } uses BaseDatos, TablaProcedencias, Mensajes, Excepciones, Literales; constructor TfrProcedencias.Create(AOwner: TComponent); begin inherited Create(AOwner); Entidad := entProcedencias; ConfigurarFrame(Self, Entidad); Application.OnException := AppException; BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaProcedencias := TIBDataSet.Create(Self); TablaProcedencias.OnNewRecord := ProcedenciasOnNewRecord; dsProcedencias.DataSet := TablaProcedencias; with TablaProcedencias do begin Database := BaseDatos; Transaction := Transaccion; InsertSQL.Assign(dmTablaProcedencias.sqlInsertar); ModifySQL.Assign(dmTablaProcedencias.sqlModificar); DeleteSQL.Assign(dmTablaProcedencias.sqlEliminar); SelectSQL.Assign(dmTablaProcedencias.sqlConsultar); end; bCancelar.Cancel := True; end; destructor TfrProcedencias.Destroy; begin Application.OnException := NIL; TablaProcedencias.Close; TablaProcedencias.UnPrepare; TablaProcedencias.Free; inherited; end; procedure TfrProcedencias.ProcedenciasOnNewRecord(DataSet: TDataSet); begin DataSet.FieldByName('CODIGO').AsInteger := dmTablaProcedencias.darContadorProcedencias; end; procedure TfrProcedencias.AppException(Sender: TObject; E: Exception); begin if E.Message = 'Field ''DESCRIPCION'' must have a value' then begin VerMensaje(msgDatosFaltaDescripcionProc); TablaProcedencias.Edit; end else if E.Message = 'violation of PRIMARY or UNIQUE KEY constraint "UNQ_PROCEDENCIAS" on table "PROCEDENCIAS"' then begin VerMensajeFmt(msgDatosProcRepetida, [UpperCase(TablaProcedencias.FieldByName('DESCRIPCION').AsString)]); TablaProcedencias.Edit; end else TratarExcepcion(E); end; procedure TfrProcedencias.ActivarModoAnadir; begin try with TablaProcedencias do begin Prepare; Open; if RecordCount = 0 then begin Edit; FieldByName('DESCRIPCION').AsString := ' '; Post; Delete end else begin Edit; Post; end; end; dmTablaProcedencias.InicializarGridProcedencias(gridProcedenciasDBTableView1); ActivarEdicionGridDetalles(gridProcedencias); 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 TfrProcedencias.RdxDBFrameShow(Sender: TObject); begin bCancelar.SetFocus; end; procedure TfrProcedencias.actAnadirExecute(Sender: TObject); begin TablaProcedencias.Insert; gridProcedencias.SetFocus; end; procedure TfrProcedencias.actEliminarExecute(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then Exit; try if TablaProcedencias.RecordCount = 0 then { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } TablaProcedencias.Cancel else TablaProcedencias.Delete except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrProcedencias.actAceptarExecute(Sender: TObject); begin if TablaProcedencias.State in [dsEdit, dsInsert] then TablaProcedencias.Post; Commit; CloseFrame; end; procedure TfrProcedencias.actCancelarExecute(Sender: TObject); begin try Rollback; CloseFrame; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrProcedencias.actAnadirUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not BaseDatos.IsReadOnly; end; procedure TfrProcedencias.actEliminarUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not BaseDatos.IsReadOnly; end; function TfrProcedencias.CambiarEntidad(EntidadAnterior, Entidad: TRdxEntidad): Boolean; begin inherited CambiarEntidad(EntidadAnterior, Entidad); ConfigurarFrame(Self, Self.Entidad); end; end.