Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 14-09-2012
elarys elarys is offline
Miembro
 
Registrado: abr 2007
Posts: 94
Poder: 18
elarys Va por buen camino
la idea es hacer algo general, alguien me puede dar la linea si esto sera posible hacerlo y por donde encararlo...
Responder Con Cita
  #2  
Antiguo 14-09-2012
elarys elarys is offline
Miembro
 
Registrado: abr 2007
Posts: 94
Poder: 18
elarys Va por buen camino
Me contesto solo por si alguno le interesa, asi quedo mi procedimiento
GetPropList, no lee los elementos de clases, entonces tuve que hacerlo con cast o casteo, no se en realidad como se dice...
No sabia castear, pero cuando lei un poco por aca y otro poco en google, fue mas facil de lo que parecia

Código Delphi [-]
procedure GetPropertyObject(Obj: TObject; List: TStringList; Counter: Integer);
var
  Names, Value, cName, iName: String;
  PInfo: PPropInfo;
  PropList: PPropList;
  Count, i, j: Integer;
  Ob: TObject;
begin
  Count := GetPropList(Obj.ClassInfo, tkProperties, nil);
  GetMem(PropList, Count * SizeOf(PPropInfo));
  GetPropList(Obj.ClassInfo, tkProperties, PropList);

  cName := Obj.ClassName;
  Delete(cName, 1, 1); //ACA LE QUITO LA T
  List.Add('<'+ cName +'>');

  for i := 0 to Count -1 do
  begin
    Value := GetPropValue(Obj, Proplist[i].Name);
    PInfo := GetPropInfo(Obj, Proplist[i].Name);
    Names := Proplist[i].Name;

    if PInfo <> nil then
    begin
      if PInfo^.PropType^.Kind = tkClass then
      begin
        Ob := GetObjectProp(Obj, Proplist[i].Name);

        if Ob is TCollection then
        begin
          List.Add('<'+ Names +'>');
          for j := 0 to (Ob as TATS_List).Count - 1 do
          begin
            iName := (Ob as TATS_List).Items[j].Name;
            Value := (Ob as TATS_List).Items[j].Value;
            List.Add('<' + iName + '>'+ Value +'+ iName +'>');
          end;
          List.Add('+ Names +'>');
        end
        else
        begin
          //NO ES DE TIPO COLECCION, PERO PUEDE SER UNA CLASE DE UN SOLO INDICE
          //OSEA UNA CLASE DENTRO DE MI CLASE PRINCIPAL... LLAMO RECURSIVAMENTE 
          GetPropertyObject(Ob, List, Counter + 1);
        end;
      end
      else
      begin
        List.Add('<'+ Names +'>'+ Value +'+ Names +'>');
      end;
    end;
  end;
  List.Add('+ cName +'>');
end;

Por las dudas aqui mi unidad Colecciones
Código Delphi [-]
unit ATS_Collections;

interface

uses
   SysUtils, Classes, Variants;

type
  TATS_Item = class(TCollectionItem)
  private
    FData: Variant;
    FName: String;
    FNull: Boolean;
    FBound: Boolean;
    FNativeStr: String;
    function GetAsVariant: Variant;
    procedure SetAsVariant(const Value: Variant);
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: Double;
    function GetAsInteger: LongInt;
    function GetAsString: String;
    function GetIsNull: Boolean;
    function IsEqual(Value: TATS_Item): Boolean;
    procedure SetAsBoolean(const Value: Boolean);
    procedure SetAsDate(const Value: TDateTime);
    procedure SetAsDateTime(const Value: TDateTime);
    procedure SetAsFloat(const Value: Double);
    procedure SetAsInteger(const Value: LongInt);
    procedure SetAsString(const Value: String);
    procedure SetAsTime(const Value: TDateTime);
    procedure SetAsWord(const Value: LongInt);
    procedure SetText(const Value: String);

  protected
    function GetDisplayName: String; override;

  public
    constructor Create(Collection: TCollection); overload; override;
    procedure Clear;
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsDate: TDateTime read GetAsDateTime write SetAsDate;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsInteger: LongInt read GetAsInteger write SetAsInteger;
    property AsString: String read GetAsString write SetAsString;
    property AsTime: TDateTime read GetAsDateTime write SetAsTime;
    property AsWord: LongInt read GetAsInteger write SetAsWord;
    property Bound: Boolean read FBound write FBound;
    property IsNull: Boolean read GetIsNull;
    property NativeStr: String read FNativeStr write FNativeStr;
    property Text: String read GetAsString write SetText;

  published
    property Name: String read FName write FName;
    property Value: Variant read GetAsVariant write SetAsVariant;
  end;


  TATS_List = class(TCollection)
  private
    function GetItem(Index: Integer): TATS_Item;
    procedure SetItem(Index: Integer; const Value: TATS_Item);

  public
    procedure AddPameter(AName: String; AValue: Variant);
    procedure AssignValues(Value: TATS_List);
    function IsEqual(Value: TATS_List): Boolean;
    function ParamByName(const Value: String): TATS_Item;
    function FindParam(const Value: String): TATS_Item;
    
    property Items[Index: Integer]: TATS_Item read GetItem write SetItem; default;
  end;

implementation

{ TATS_Item }

constructor TATS_Item.Create(Collection: TCollection);
begin
  inherited;
  FNull := True;
end;

procedure TATS_Item.Clear;
begin
  FNull := True;
  FData := Unassigned;
end;

function TATS_Item.GetAsBoolean: Boolean;
begin
  if IsNull then
    Result := False
  else
    Result := FData;
end;

function TATS_Item.GetAsDateTime: TDateTime;
begin
  if IsNull then
    Result := 0
  else
    Result := VarToDateTime(FData);
end;

function TATS_Item.GetAsFloat: Double;
begin
  if IsNull then
    Result := 0
  else
    Result := FData;
end;

function TATS_Item.GetAsInteger: LongInt;
begin
  if IsNull then
    Result := 0
  else
    Result := FData;
end;

function TATS_Item.GetAsString: String;
begin
  if IsNull then
    Result := ''
  else
    Result := FData;
end;

function TATS_Item.GetAsVariant: Variant;
begin
  Result := FData;
end;

function TATS_Item.GetIsNull: Boolean;
begin
  Result := FNull or VarIsNull(FData) or VarIsClear(FData);
end;

procedure TATS_Item.SetAsBoolean(const Value: Boolean);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsDate(const Value: TDateTime);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsDateTime(const Value: TDateTime);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsFloat(const Value: Double);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsInteger(const Value: LongInt);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsString(const Value: String);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsTime(const Value: TDateTime);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetAsVariant(const Value: Variant);
begin
  FNull := VarIsClear(Value) or VarIsNull(Value);
  FData := Value;
end;

procedure TATS_Item.SetAsWord(const Value: LongInt);
begin
  Self.Value := Value;
end;

procedure TATS_Item.SetText(const Value: String);
begin
  Self.Value := Value;
end;

function TATS_Item.GetDisplayName: String;
begin
  if FName = '' then
    Result := inherited GetDisplayName
  else
    Result := FName;
end;

function TATS_Item.IsEqual(Value: TATS_Item): Boolean;
begin
  Result := (VarType(FData) = VarType(Value.FData)) and
    (VarIsClear(FData) or (FData = Value.FData)) and
    (Name = Value.Name) and (IsNull = Value.IsNull);
end;

{ TATS_List}

procedure TATS_List.AddPameter(AName: String; AValue: Variant);
var
  P: TATS_Item;
begin
  P := TATS_Item(Self.Add);
  P.Name := AName;
  P.Value := AValue;
end;

procedure TATS_List.AssignValues(Value: TATS_List);
var
  I: Integer;
  P: TATS_Item;
begin
  for I := 0 to Value.Count - 1 do
  begin
    P := FindParam(Value[i].Name);
    if P <> nil then
      P.Assign(Value[i]);
  end;
end;

function TATS_List.FindParam(const Value: String): TATS_Item;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
  begin
    Result := TATS_Item(inherited Items[i]);
    if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  end;
  Result := nil;
end;

function TATS_List.GetItem(Index: Integer): TATS_Item;
begin
  Result := TATS_Item(inherited Items[Index]);
end;

function TATS_List.IsEqual(Value: TATS_List): Boolean;
var
  I: Integer;
begin
  Result := Count = Value.Count;
  if Result then
    for I := 0 to Count - 1 do
    begin
      Result := Items[i].IsEqual(Value.Items[i]);
      if not Result then Break;
    end
end;

function TATS_List.ParamByName(const Value: String): TATS_Item;
begin
  Result := FindParam(Value);
  if Result = nil then
    raise Exception.Create('El parámetro no fue localizado');
end;

procedure TATS_List.SetItem(Index: Integer; const Value: TATS_Item);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

end.

Última edición por elarys fecha: 14-09-2012 a las 17:28:31.
Responder Con Cita
  #3  
Antiguo 14-09-2012
Avatar de movorack
[movorack] movorack is offline
Miguel A. Valero
 
Registrado: feb 2007
Ubicación: Bogotá - Colombia
Posts: 1.346
Poder: 20
movorack Va camino a la famamovorack Va camino a la fama
Me alegro que hallas solucionado tu problema. Pero desde dentro o desde fuera debiste tener el "conocimiento" de que propiedades tiene la colección por dentro.
__________________
Buena caza y buen remar... http://mivaler.blogspot.com
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Casteo y Migración maunix Varios 6 26-09-2011 16:46:29
Crear un TCollection kloud C++ Builder 2 04-04-2006 13:52:54
Casteo en tiempo de ejecución moesis OOP 4 21-07-2005 15:21:56
Herencia y Casteo PeLuCa OOP 9 05-04-2005 01:29:15
TCollection Igna OOP 2 24-06-2003 12:24:14


La franja horaria es GMT +2. Ahora son las 19:36:53.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi