Ver Mensaje Individual
  #3  
Antiguo 19-12-2009
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Reputación: 31
Lepe Va por buen camino
Yo hace unos años hice algo similar (quizás algo más complicado... no sé)

Si te fijas en un TField, tiene las propiedades Name y despues en Value tiene un valor variant, además tiene propiedades AsString, AsDateTime, etc...

Copiando esa estructura hacia un Tobject, podrías usar un código similar a este:
Código Delphi [-]

var v : TDualElement;
begin 
  v := TDualElement.Create;
  v.Caption:= label1.caption;
  v.AsDateTime := Now();
  ShowMessage(v.AsString);
...

v.free;
Si ahora usas un TObjectList o un array, puedes tener cuantas "variables de las que tu quieres" en memoria y crearlas en tiempo de ejecución.

Acabo de mirarlo y no tiene terceras dependencias... échale un vistazo:
Código Delphi [-]

interface
  uses sysutils,classes, contnrs,dialogs, variants, DB,
      Forms, Controls, windows;

type



{------------------------------------------------------------------------------
 TVariantElement  es un variant con:

 AsString
 AsInteger
 AsInteger64
 AsFloat
 AsDateTime
 AsBoolean
-------------------------------------------------------------------------------}

  TVariantElement = class(TObject)
  private
    FValue: Variant;
    function GetValuetype: TVarType;
    function GetString: string;
    procedure SetString(const Value: string);
    function GetDateTime: TDateTime;
    procedure SetDateTime(const Value: TDateTime);
    procedure SetFloat(const Value: Extended);
    function GetFloat: Extended;
    function GetInteger64: int64;
    procedure SetInteger64(const Value: int64);

    function InternalFloat:Extended;
    function InternalInteger:Int64;
    function GetBool: Boolean;
    procedure SetBool(const Value: Boolean);
    function GetInteger: Integer;
    procedure SetInteger(const Value: Integer);
  public
    property Value:Variant         read FValue       write FValue;
    property ValueType:TVarType    read GetValuetype;

    property AsString:string       read GetString    write SetString;
    property AsBoolean:Boolean     read GetBool      write SetBool;
    property AsFloat:Extended      read GetFloat     write SetFloat;
    property AsDateTime: TDateTime read GetDateTime  write SetDateTime;
    property AsInteger64:int64     read GetInteger64 write SetInteger64;
    property AsInteger:Integer     read GetInteger   write SetInteger;

  end;

  TDualElement = class(TVariantElement)
  private
    FCaption:string;
    FData: string;
  public
    property Caption :string read FCaption write FCaption;
    property Data :string    read FData    write FData;
  end;

  TDE = TDualElement;

  TSort = (sCaption, sValue,sNone);
  TSortOrder = (soAsc, soDesc,soNone);

    {-----FUNCIONES DE ORDENACION INTERNAS DE TDualList-----------------------}
    function CaptionAsc(item1, item2:Pointer):Integer;
    function CaptionDesc(item1, item2:Pointer):Integer;

    function ValueAsc(item1, item2:Pointer):Integer;
    function ValueDesc(item1, item2:Pointer):Integer;

{-----------------------------------------------------------------------------
  Class TDualList

  Una lista que permite asociar un String con su valor Variant.

  IndexOfKey es 'case INSensitive'
  IndexOfValue devuelve -1 si el tipo del variant no coincide.

  Si el usuario de la clase no hace IntTostr(Value) obtendrá una excepción
  en una expresión del tipo:

    ShowMessage(' Valor = ' + Value)
-----------------------------------------------------------------------------}
type

  TDualList = class(TObject)
  private
    FList:TObjectList;
    FOldSortBy:TSort; // remenber the las Sorted mode.
    FOldOrder:TSortOrder; // remenber the las Sorted mode.
  public
    constructor Create;   // OwnObjects := true;
    destructor Destroy;override;
    function Add          (Element:TDualElement): Integer;
    function IndexOfKey   (const Caption:string):Integer;
    function IndexOfValue (const Value:Variant):Integer;
    procedure Remove      (const Index:Integer);overload;
    procedure Remove      (const Caption:string);overload;
    procedure Sort        (const SortBy:TSort;const Order:TSortOrder);overload;
    procedure Sort        (funcion:TListSortCompare);overload;
    function Get          (Index:Integer;var Caption:string;var Value:Variant):Boolean;
    function GetElement   (Index:Integer):TDualElement;
    function Extract      (Index:integer):TDualElement;
    function Count:Integer;

  end;



implementation
{ TVariantElement }


function TVariantElement.GetBool: Boolean;
begin
  if VarIsType(FValue,[varNull, varEmpty, varUnknown,varError ]) then
    Result:= False
  else
    Result := Boolean(VarToStr(FValue)<> '0');
end;

function TvariantElement.GetDateTime: TDateTime;
begin
  if VarIsType(FValue,[varDouble,varCurrency, varDate]) then
    Result := VarToDateTime(FValue)
  else
    Result := 0.0
end;

function TvariantElement.GetFloat: Extended;
begin
  if VarIsType(FValue,[varCurrency ,varDouble, varInteger, varDate,varByte,varWord]) then
    Result:= Extended(FValue)
  else
    Result:= InternalFloat;
end;

function TVariantElement.GetInteger: Integer;
var i64:Int64;
begin
  i64 := GetInteger64;
  Result:= i64; // same rules as VCL
  // if the number is too large, a negative value is return.
end;

function TvariantElement.GetInteger64: int64;
begin
  if VarIsType(FValue,[varCurrency ,varDouble, varDate, varWord]) then
      Result := Trunc(FValue)
  else if VarIsType(FValue, [varShortInt, varSmallint, varInteger, varInt64]) then
      Result := FValue
  else if VarIsType(FValue, [varEmpty ,varNull,varError,varUnknown ]) then
    Result := 0
  else
    Result:= internalInteger;
end;

function TvariantElement.GetString: string;
begin
  Result:= VarToStr(FValue);
end;

function TvariantElement.GetValuetype: TVarType;
begin
  Result := VarType(FValue)
end;

function TvariantElement.InternalFloat: Extended;
var tmp:string;
    l,i:Integer;
    NowIsFloat:Boolean;
begin
  tmp := Trim(VarToStr(FValue));
  l:= Length(tmp);
  NowIsFloat := True;
  Result:=0;
  if l >=1 then
  begin
    if tmp[1] in ['-','+'] then
      i:=2
    else
      i:=1;
    while i<= l do
    begin
      NowIsFloat :=  NowIsFloat and (
                          IsDecimalNumber(tmp[i]) or
                          (tmp[i] = ',') or  // flexible decimal separator
                          (tmp[i] = '.')
                         );
      if NowIsFloat then
      begin
        if (tmp[i] = ',') or
           (tmp[i] = '.') then // flexible decimal separator
           tmp[i] := DecimalSeparator;
      end
      else
        Break;
      Inc(i);
    end;
    if not texttofloat(PChar(Copy(tmp,1,i-1)), Result,fvExtended) then
      Result:=0;
  end
end;

function TvariantElement.InternalInteger: Int64;
var tmp:string;
    l,i:Integer;
begin
  tmp := Trim(VarToStr(FValue));
  l:= Length(tmp);
  Result:=0;
  if l >=1 then
  begin
    if tmp[1] in ['-','+'] then
      i:=2
    else
      i:=1;
    while i <=l do
    begin
      Inc(i);
      if not IsDecimalNumber(tmp[i]) then
        break;
    end;
      Result:= StrToInt64Def(Copy(tmp,1,i-1),0)
  end
end;

procedure TVariantElement.SetBool(const Value: Boolean);
begin
  FValue := Value;
end;

procedure TvariantElement.SetDateTime(const Value: TDateTime);
begin
  FValue := VarFromDateTime(Value);
end;

procedure TvariantElement.SetFloat(const Value: Extended);
begin
  FValue := Value;
end;

procedure TVariantElement.SetInteger(const Value: Integer);
begin
  FValue := Value;
end;

procedure TvariantElement.SetInteger64(const Value: int64);
begin
  FValue := Value;
end;

procedure TvariantElement.SetString(const Value: string);
begin
  FValue := string(Value);
end;

{ TDualList }
function TDualList.Add(Element:TDualElement): Integer;
begin
  FOldSortBy := sNone;
  FOldOrder := soNone;
  Result:= FList.Add(TObject(Element));
end;

function TDualList.Count: Integer;
begin
  Result := FList.Count;
end;

constructor TDualList.Create;
begin
  inherited Create;
  FList := TObjectList.Create(True);
  FOldSortBy := sNone;
  FOldOrder := soNone;
end;

destructor TDualList.destroy;
begin
  FList.Pack;
  FreeAndNil(FList);
  inherited ;
end;

function TDualList.Extract(Index: integer): TDualElement;
begin
  Result := TDualelement(FList.Extract(FList.Items[Index]));
  FList.Pack;
end;

function TDualList.Get(Index: Integer; var Caption: string;
  var Value: Variant): Boolean;
begin
  Result:= (Index >-1) and (Index < FList.Count);
  if Result then
  begin
    Caption := TDualElement(FList.Items[Index]).Caption;
    Value   := TDualElement(FList.Items[Index]).Value;
  end
  else
  begin
    Caption := EmptyStr;
    Value:= Unassigned;
  end;
end;

function TDualList.GetElement(Index: Integer): TDualElement;
begin
  Result := nil;
  if (Index >-1) and (Index < FList.Count) then
    Result := TDualElement(FList.Items[Index]);

end;

function TDualList.IndexOfKey(const Caption: string): Integer;
begin
  Result:=0;
  while (Result < FList.Count) do
    if AnsiCompareText(TDualElement(FList.Items[result]).Caption , Caption)= 0 then
      Break
    else
      Result := Result+1;

  if Result > FList.Count-1 then Result := -1;
end;

{-----------------------------------------------------------------------------
  Procedure: TDualList.IndexOfValue
  Author:    Lepe
  Date:      13-nov-2005
  Arguments: const Value: Variant
  Result:    Integer
  Purpose:  buscar por el valor de un Variant

-----------------------------------------------------------------------------}
function TDualList.IndexOfValue(const Value: Variant): Integer;
begin
  Result:=0;
  while (Result < FList.Count) do
  begin
    if TDualElement(FList.Items[result]).AsString = VarToStr(Value) then
      Break;
    Result := Result+1;
  end;
  if Result > FList.Count-1 then Result := -1;

end;

procedure TDualList.Remove(const Index: Integer);
begin
  if (Index >-1) and (Index < FList.Count) then
  begin
    FList.Remove(FList.Items[Index]);
    FList.Pack;
  end;

end;

procedure TDualList.Remove(const Caption: string);
begin
  Remove(IndexOfKey(Caption));
end;

procedure TDualList.Sort(const SortBy: TSort; const Order: TSortOrder);
var funcion:TListSortCompare;
begin
  if (SortBy <> FOldSortBy) or (Order <> FOldOrder) then
  begin
    FOldSortBy := SortBy;
    FOldOrder := Order;
    case SortBy of
      scaption :
                  if Order = soAsc then
                    funcion := CaptionAsc
                  else
                    funcion := CaptionDesc;

      else
              if Order = soAsc then
                funcion := ValueAsc
              else
                funcion := ValueDesc;
    end;
    FList.Sort(funcion);
  end
end;

procedure TDualList.Sort(funcion: TListSortCompare);
begin
  FList.Sort(funcion);
end;

{ TDualElement }

    {-----FUNCIONES DE ORDENACION INTERNAS DE TDualList-----------------------}
function CaptionAsc(item1, item2:Pointer):Integer;
begin
Result := CompareText(TDualelement(item1).Caption,
              TDualelement(item2).Caption);

end;

function CaptionDesc(item1, item2:Pointer):Integer;
begin
  Result := CaptionAsc(item1,item2);
  if Result <> 0 then
  begin
    if Result >0 then Result:= -1
    else Result := 1;
  end;
end;
{------------------------------------------------------------------------------
  al comparar, pasamos todo a caracteres, y además añadimos ceros por la
  izquierda, ya que el máximo tipo es Int64, que puede tener hasta 19 dígitos.
  Como siempre sea añaden ceros, la comparación debe ser correcta.

-------------------------------------------------------------------------------}
function ValueAsc(item1, item2:Pointer):Integer;
begin
  Result := CompareText(PadLeft(TDualElement(item1).AsString,'0',19),
                        PadLeft(TDualElement(item2).AsString,'0',19))
end;

function ValueDesc(item1, item2:Pointer):Integer;
begin
  Result := ValueAsc(item1,item2);
  if Result <> 0 then
  begin
    if Result > 0 then Result:= -1
    else Result := 1;
  end;
end;
Buen provecho
__________________
Si usted entendió mi comentario, contácteme y gustosamente,
se lo volveré a explicar hasta que no lo entienda, Gracias.
Responder Con Cita