{ =============================================================================== 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: 19-08-2003 Versión actual: 1.0.0 Fecha versión actual: 19-08-2003 =============================================================================== Modificaciones: Fecha Comentarios --------------------------------------------------------------------------- =============================================================================== } unit Propiedades; 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, StdCtrls, cxContainer, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxDBEdit, ActnList, RdxRadioButton, Entidades, Menus, am2000menuitem, am2000utils, am2000popupmenu, am2000, cxDataStorage; type TfrPropiedades = class(TRdxDBFrame) BarraPropiedades: TRdxBarraSuperior; dsPropiedades: TDataSource; bAnadir: TRdxBoton; bEliminar: TRdxBoton; gridPropiedades: TcxGrid; VistaPropiedades: TcxGridDBTableView; gridPropiedadesLevel1: TcxGridLevel; pnlOpciones: TGroupBox; pnlGridValores: TRdxPanel; gridValores: TcxGrid; VistaValores: TcxGridDBTableView; gridValoresLevel1: TcxGridLevel; RdxPanel1: TRdxPanel; bAnadirValor: TRdxBoton; bEliminarValor: TRdxBoton; dsValores: TDataSource; Op1: TRdxRadioButton; Op3: TRdxRadioButton; Op2: TRdxRadioButton; cbxPropiedad: TcxComboBox; Acciones: TActionList; actAnadirProp: TAction; actEliminarProp: TAction; actOpc1: TAction; actOpc2: TAction; actOpc3: TAction; actAnadirValor: TAction; actEliminarValor: TAction; bAceptar: TRdxBoton; bCancelar: TRdxBoton; pnlCuerpo: TPanel; brOperacion: TRdxBarraInferior; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; RdxPanel2: TRdxPanel; imgSombra: TImage; MenuOpcionesImg: TPopupMenu2000; mCortar: TMenuItem2000; mCopiar: TMenuItem2000; mPegar: TMenuItem2000; mInsertar: TMenuItem2000; ActionList1: TActionList; actInsertar: TAction; actCopiar: TAction; actCortar: TAction; actPegar: TAction; bImagen: TRdxBotonMenu; actEliminar: TAction; mEliminar: TMenuItem2000; actGuardar: TAction; mGuardar: TMenuItem2000; MenuItem1: TMenuItem2000; procedure bAceptarClick(Sender: TObject); procedure bCancelarClick(Sender: TObject); procedure actAnadirPropExecute(Sender: TObject); procedure actEliminarPropExecute(Sender: TObject); procedure actAnadirValorExecute(Sender: TObject); procedure actEliminarValorExecute(Sender: TObject); procedure actOpc2Execute(Sender: TObject); procedure actAnadirValorUpdate(Sender: TObject); procedure actAnadirPropUpdate(Sender: TObject); procedure actEliminarPropUpdate(Sender: TObject); procedure actOpc1Update(Sender: TObject); procedure cbxPropiedadPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure actOpc1Execute(Sender: TObject); procedure actOpc3Execute(Sender: TObject); procedure actInsertarExecute(Sender: TObject); procedure actCopiarExecute(Sender: TObject); procedure actPegarExecute(Sender: TObject); procedure actEliminarExecute(Sender: TObject); procedure actCortarExecute(Sender: TObject); procedure actGuardarExecute(Sender: TObject); private FCodigoProp : Variant; FPropiedadCodigo : TStringList; FCodigoPropiedad : TStringList; TablaPropiedades : TIBDataSet; TablaValores : TIBDataSet; FCodigoPro: Variant; procedure SetCodigoPro(const Value: Variant); property CodigoPro : Variant read FCodigoPro write SetCodigoPro; procedure RecargarDatos; procedure GuardarDatos; procedure BorrarTodo; procedure ValoresOnNewRecord(DataSet: TDataSet); procedure PropiedadesNewRecord(DataSet: TDataSet); procedure PropiedadesAfterPost(DataSet: TDataSet); procedure PropiedadesAfterInsert(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); procedure VistaPropiedadesFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); end; var frPropiedades: TfrPropiedades; implementation {$R *.DFM} { TfrPropiedades2 } uses BaseDatos, TablaPropiedades, TablaValores, Mensajes, Excepciones, Literales, StrFunc, Variants, jpeg; constructor TfrPropiedades.Create(AOwner: TComponent); begin inherited Create(AOwner); Entidad := entOpciones; ConfigurarFrame(Self, Entidad); Application.OnException := AppException; BaseDatos := dmBaseDatos.BD; Transaccion := dmBaseDatos.Transaccion; TablaPropiedades := TIBDataSet.Create(Self); with TablaPropiedades do begin Database := BaseDatos; Transaction := Transaccion; InsertSQL.Assign(dmTablaPropiedades.sqlInsertar); ModifySQL.Assign(dmTablaPropiedades.sqlModificar); DeleteSQL.Assign(dmTablaPropiedades.sqlEliminar); SelectSQL.Assign(dmTablaPropiedades.sqlConsultar); AfterPost := PropiedadesAfterPost; AfterInsert := PropiedadesAfterInsert; OnNewRecord := PropiedadesNewRecord; end; dsPropiedades.DataSet := TablaPropiedades; TablaValores := TIBDataSet.Create(Self); with TablaValores do begin Database := BaseDatos; Transaction := Transaccion; InsertSQL.Assign(dmTablaValores.sqlInsertar); ModifySQL.Assign(dmTablaValores.sqlModificar); DeleteSQL.Assign(dmTablaValores.sqlEliminar); SelectSQL.Assign(dmTablaValores.sqlConsultar); OnNewRecord := ValoresOnNewRecord; end; dsValores.DataSet := TablaValores; end; destructor TfrPropiedades.Destroy; begin Application.OnException := NIL; TablaPropiedades.Close; TablaPropiedades.UnPrepare; TablaPropiedades.Free; TablaValores.Close; TablaValores.UnPrepare; TablaValores.Free; FPropiedadCodigo.Free; FCodigoPropiedad.Free; inherited; end; procedure TfrPropiedades.bAceptarClick(Sender: TObject); begin if TablaPropiedades.State in dsEditModes then TablaPropiedades.Post; GuardarDatos; Commit; CloseFrame; end; procedure TfrPropiedades.bCancelarClick(Sender: TObject); begin try Rollback; CloseFrame; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.AppException(Sender: TObject; E: Exception); begin if E.Message = 'Field ''DESCRIPCION'' must have a value' then begin VerMensaje(msgDatosFaltaDescripcionProp); TablaPropiedades.Edit; end else if E.Message = 'violation of PRIMARY or UNIQUE KEY constraint "PK_PROPIEDADES" on table "PROPIEDADES"' then begin VerMensajeFmt(msgDatosPropiedadRepetida, [UpperCase(TablaPropiedades.FieldByName('DESCRIPCION').AsString)]); TablaPropiedades.Edit; end else TratarExcepcion(E); end; procedure TfrPropiedades.ActivarModoAnadir; begin try with TablaPropiedades do begin Prepare; Open; if RecordCount = 0 then begin Edit; FieldByName('DESCRIPCION').AsString := ' '; Post; Delete end else begin Edit; Post; end; end; dmTablaPropiedades.InicializarGridPropiedades(VistaPropiedades); dmTablaValores.InicializarGridValores(VistaValores); VistaPropiedades.OnFocusedRecordChanged := VistaPropiedadesFocusedRecordChanged; VistaPropiedades.DataController.GotoFirst; //Asignamos el codigo de propiedad para establecer valores de la misma if TablaPropiedades.RecordCount > 0 then CodigoPro := TablaPropiedades.FieldByName('CODIGO').AsString; except on E : EIBError do begin case E.IBErrorCode of isc_lock_conflict : begin Rollback; VerMensaje(msgDatosTablaPropBloqueada); CloseFrame; end else begin Rollback; TratarExcepcion(E); end; end; end; on E : Exception do begin Rollback; TratarExcepcion(E); end; end; end; procedure TfrPropiedades.PropiedadesAfterPost(DataSet: TDataSet); begin FPropiedadCodigo := TStringList.Create; FCodigoPropiedad := TStringList.Create; dmTablaPropiedades.darPropiedades(FPropiedadCodigo, FCodigoPropiedad); cbxPropiedad.Properties.Items := dmTablaPropiedades.darPropiedades; end; procedure TfrPropiedades.VistaPropiedadesFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); begin if (not EsCadenaVacia(TablaPropiedades.FieldByName('CODIGO').AsString)) then //Asignamos el codigo de propiedad para establecer valores de la misma CodigoPro := TablaPropiedades.FieldByName('CODIGO').AsString; end; procedure TfrPropiedades.PropiedadesAfterInsert(DataSet: TDataSet); begin if DataSet.State in dsEditModes then DataSet.Post; DataSet.Edit; end; procedure TfrPropiedades.SetCodigoPro(const Value: Variant); begin if (FCodigoPro <> Value) then begin GuardarDatos; FCodigoPro := Value; RecargarDatos; end; end; procedure TfrPropiedades.RecargarDatos; var lPropiedadRel : Variant; begin with TablaValores do begin Close; Params.ByName('CODIGOPROPIEDAD').AsString := CodigoPro; Prepare; Open; end; cbxPropiedad.ItemIndex := -1; cbxPropiedad.Enabled := False; if (TablaValores.RecordCount > 0) then Op3.Checked := True else begin lPropiedadRel := dmTablaPropiedades.darPropiedadRelacionada(CodigoPro); if (lPropiedadRel <> -1) then begin Op2.Checked := True; cbxPropiedad.ItemIndex := cbxPropiedad.Properties.Items.IndexOf(FCodigoPropiedad.Values[lPropiedadRel]); cbxPropiedad.Enabled := True; end else Op1.Checked := True; end; end; procedure TfrPropiedades.GuardarDatos; begin if TablaValores.State in dsEditModes then TablaValores.Post; if (Op1.Checked) then borrarTodo else if (Op2.Checked) then begin if EsCadenaVacia(cbxPropiedad.Text) then begin cbxPropiedad.SetFocus; raise Exception.Create(msgDatosCopiaVacia); end; borrarTodo; dmTablaPropiedades.asignarCopiaPropiedad(CodigoPro, StrToInt(FPropiedadCodigo.Values[cbxPropiedad.Text])); end else if (Op3.Checked) then begin dmTablaPropiedades.asignarNullCopiaPropiedad(CodigoPro); end; end; procedure TfrPropiedades.borrarTodo; begin dmTablaValores.borrarValoresPropiedad(CodigoPro); dmTablaPropiedades.asignarNullCopiaPropiedad(CodigoPro); end; procedure TfrPropiedades.actAnadirPropExecute(Sender: TObject); begin TablaPropiedades.Append; gridPropiedades.SetFocus; end; procedure TfrPropiedades.actEliminarPropExecute(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then Exit; try if TablaPropiedades.RecordCount = 0 { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } then TablaPropiedades.Cancel else TablaPropiedades.Delete; except on E : EIBError do verMensaje(msgDatosPropiedadUsada); // TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actAnadirValorExecute(Sender: TObject); begin TablaValores.Append; GridValores.SetFocus; end; procedure TfrPropiedades.actEliminarValorExecute(Sender: TObject); begin if (VerMensajePregunta(msgDeseaBorrar) <> IDYES) then Exit; try if TablaValores.RecordCount = 0 then { Hacemos un cancel de la tabla por si el registro actual estuviera recien creado } TablaValores.Cancel else TablaValores.Delete; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actOpc2Execute(Sender: TObject); begin cbxPropiedad.Enabled := True; cbxPropiedad.SetFocus; end; procedure TfrPropiedades.actAnadirValorUpdate(Sender: TObject); begin (Sender as TAction).Enabled := Op3.Checked; gridValores.Enabled := Op3.Checked; end; procedure TfrPropiedades.actAnadirPropUpdate(Sender: TObject); begin (Sender as TAction).Enabled := not dmBaseDatos.BD.IsReadOnly; end; procedure TfrPropiedades.actEliminarPropUpdate(Sender: TObject); begin (Sender as TAction).Enabled := (not dmBaseDatos.BD.IsReadOnly) and (VistaPropiedades.DataController.RowCount > 0); end; procedure TfrPropiedades.actOpc1Update(Sender: TObject); begin (Sender as TAction).Enabled := TablaPropiedades.RecordCount > 0; cbxPropiedad.Enabled := Op2.Checked; end; procedure TfrPropiedades.cbxPropiedadPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); begin if DisplayValue = TablaPropiedades.FieldByName('DESCRIPCION').AsVariant then begin ErrorText := msgDatosCopiaInvalida; Error := True; end; end; procedure TfrPropiedades.PropiedadesNewRecord(DataSet: TDataSet); begin with DataSet do begin CodigoPro := dmTablaPropiedades.DarContadorPropiedad; FieldByName('CODIGO').AsInteger := CodigoPro; FieldByName('DESCRIPCION').AsString := 'Propiedad nueva'; end; end; procedure TfrPropiedades.actOpc1Execute(Sender: TObject); begin // end; procedure TfrPropiedades.actOpc3Execute(Sender: TObject); begin // end; procedure TfrPropiedades.ValoresOnNewRecord(DataSet: TDataSet); begin DataSet.FieldByName('CODIGO').AsInteger := dmTablaValores.DarContadorValor; DataSet.FieldByName('CODIGOPROPIEDAD').AsString := CodigoPro; end; function TfrPropiedades.CambiarEntidad(EntidadAnterior, Entidad: TRdxEntidad): Boolean; begin inherited CambiarEntidad(EntidadAnterior, Entidad); ConfigurarFrame(Self, Self.Entidad); end; procedure TfrPropiedades.actInsertarExecute(Sender: TObject); var lImgAux: TJPEGImage; Fichero: Variant; begin try Fichero := elegirImagen; if not esCadenaVacia(Fichero) then begin lImgAux := TJPEGImage.Create; lImgAux.LoadFromFile(Fichero); TablaValores.Edit; TablaValores.FieldByName('IMAGEN').Assign(lImgAux); TablaValores.Post; FreeAndNil(lImgAux); end; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actCopiarExecute(Sender: TObject); var lImgAux: TJPEGImage; lStrAux: TStream; begin try lImgAux := TJPEGImage.Create; lStrAux := TablaValores.CreateBlobStream(TablaValores.FieldByName('IMAGEN'), bmReadWrite); lImgAux.LoadFromStream(lStrAux); copiarAlPortapapeles(lImgAux); FreeAndNil(lStrAux); FreeAndNil(lImgAux); except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actPegarExecute(Sender: TObject); var lImgAux: TJPEGImage; begin try lImgAux:= TJPEGImage.Create; lImgAux.Assign(copiarDelPortapapeles); TablaValores.Edit; TablaValores.FieldByName('IMAGEN').Assign(lImgAux); TablaValores.Post; FreeAndNil(lImgAux); actCortar.Enabled := True; actCopiar.Enabled := True; actEliminar.Enabled := True; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actEliminarExecute(Sender: TObject); begin try TablaValores.Edit; TablaValores.FieldByName('IMAGEN').Clear; TablaValores.Post; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; procedure TfrPropiedades.actCortarExecute(Sender: TObject); begin actCopiarExecute(Self); actEliminarExecute(Self); actCortar.Enabled := False; actCopiar.Enabled := False; actEliminar.Enabled := False; end; procedure TfrPropiedades.actGuardarExecute(Sender: TObject); var lImgAux: TJPEGImage; lStrAux: TStream; Fichero : Variant; begin try Fichero := guardarComoImagen; if not esCadenaVacia(Fichero) then begin lImgAux := TJPEGImage.Create; lStrAux := TablaValores.CreateBlobStream(TablaValores.FieldByName('IMAGEN'), bmReadWrite); lImgAux.LoadFromStream(lStrAux); lImgAux.SaveToFile(Fichero); FreeAndNil(lStrAux); FreeAndNil(lImgAux); end; except on E : EIBError do TratarExcepcion(E); on E : Exception do TratarExcepcion(E); end; end; end.