david
ab4c274533
git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES/trunk@4 3f40d355-893c-4141-8e64-b1d9be72e7e7
637 lines
18 KiB
ObjectPascal
637 lines
18 KiB
ObjectPascal
{
|
|
===============================================================================
|
|
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.
|