unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, DBCtrls, Grids, DBGrids, StdCtrls, ExtCtrls;
type
TClon = class(TForm)
Con: TADOConnection;
qrCaballos: TADOQuery;
dsCaballos: TDataSource;
dsClonCaballos: TDataSource;
Panel1: TPanel;
bnClonar: TButton;
grCaballos: TDBGrid;
nvCaballos: TDBNavigator;
DBNavigator1: TDBNavigator;
DBGrid1: TDBGrid;
tbRefPersonas: TADOTable;
qrCaballosIdCaballo: TIntegerField;
qrCaballosCaballo: TWideStringField;
qrCaballosIdPropietario: TIntegerField;
qrCaballosPropietario: TStringField;
procedure bnClonarClick(Sender: TObject);
procedure qrCaballosNewRecord(DataSet: TDataSet);
procedure FormCreate(Sender: TObject);
private
procedure ClonNewRecord(DataSet: TDataSet);
{ Private declarations }
public
{ Public declarations }
end;
var
Clon: TClon;
implementation
{$R *.dfm}
procedure CrearCamposPersistentes(aDataSet : TDataSet);
var
i: Integer;
NuevoCampo: TField;
begin
with aDataSet do
begin
FieldDefs.Update;
for i := 0 to FieldDefs.Count -1 do
begin
NuevoCampo := nil;
case FieldDefs[i].DataType of
ftString : NuevoCampo := TField( TStringField.Create( aDataSet ));
ftWideString : NuevoCampo := TField( TWideStringField.Create( aDataSet ));
ftLargeint : NuevoCampo := TField( TLargeintField.Create( aDataSet ));
ftSmallint : NuevoCampo := TField( TSmallIntField.Create( aDataSet ));
ftInteger : NuevoCampo := TField( TIntegerField.Create( aDataSet ));
ftBoolean : NuevoCampo := TField( TBooleanField.Create( aDataSet ));
ftFloat : NuevoCampo := TField( TFloatField.Create( aDataSet ));
ftCurrency : NuevoCampo := TField( TCurrencyField.Create( aDataSet ));
ftBCD : NuevoCampo := TField( TBCDField.Create( aDataSet ));
ftDate : NuevoCampo := TField( TDateField.Create( aDataSet ));
ftTime : NuevoCampo := TField( TTimeField.Create( aDataSet ));
ftDateTime : NuevoCampo := TField( TDateTimeField.Create( aDataSet ));
ftAutoInc : NuevoCampo := TField( TAutoIncField.Create( aDataSet ));
ftBlob : NuevoCampo := TField( TBlobField.Create( aDataSet ));
ftMemo : NuevoCampo := TField( TMemoField.Create( aDataSet ));
ftGraphic : NuevoCampo := TField( TGraphicField.Create( aDataSet ));
else
raise Exception.Create( 'El "'+ FieldDefs[i].DisplayName +'"' + ' no es soportado.' );
end;
if NuevoCampo <> nil then
with NuevoCampo do
begin
FieldName := aDataSet.FieldDefs[i].DisplayName;
Size := aDataSet.FieldDefs[i].Size;
DataSet := aDataSet;
end;
end;
end;
end;
procedure TClon.bnClonarClick(Sender: TObject);
var
qrClon : TADOQuery;
begin
qrClon:= TADOQuery.Create(Self);
qrClon.Connection := Con;
qrClon.SQL := qrCaballos.SQL;
CrearCamposPersistentes(qrClon);
with TStringField.Create(qrClon) do //Aquí creamos el campo lookUp
begin
FieldName := 'ClonPropietario';
FieldKind := fkLookup;
DataSet := qrClon;
Name := 'ClonPropietario';
KeyFields := 'IdPropietario';
LookupDataSet := tbRefPersonas;
LookupKeyFields := 'IdPersona';
LookupResultField := 'Nombre';
qrClon.FieldDefs.Add('ClonPropietario', ftString, 20, False);
end;
dsClonCaballos.DataSet := qrClon;
qrClon.OnNewRecord:= ClonNewRecord; // El procedimiento debe tener los mismos
//parámetros que el evento
qrClon.Open;
end;
procedure TClon.ClonNewRecord(DataSet: TDataSet);
begin
Showmessage('Agregando en el clon')
end;
procedure TClon.qrCaballosNewRecord(DataSet: TDataSet);
begin
Showmessage('Agregando')
end;
procedure TClon.FormCreate(Sender: TObject);
var
BaseDeDatos, ConStr : String;
begin
Con.Close;//Por si se queda abierto en tiempo de diseño
// Obtiene la ruta y el nombre de la base de datos
ConStr := '';
BaseDeDatos := ExtractFilePath(Application.ExeName)+'DB.MDB';
if not FileExists(BaseDeDatos) then raise
exception.Create('Error al cargar Base de Datos')else
begin
ConStr := 'Provider=Microsoft.Jet.OLEDB.4.0;'+
'Data Source='+BaseDeDatos+';'+
'Persist Security Info=False;'+
'Jet OLEDB:Database Password=admin';
Con.ConnectionString := ConStr;
Con.Open;
qrCaballos.Open;
end;
end;
end.