{ ------------------------------------------------------------- }
{ Purpose : Next Common 6                                       }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2012. All Rights Reserved.         }
{ ------------------------------------------------------------- }
{ mm/dd/yy comment                                              }
{ -------- ---------------------------------------------------- }
{ 08/06/13 Initial code                                         }
{ ------------------------------------------------------------- }
{ Todo :                                                        }
{ ------------------------------------------------------------- }
unit NxTypInfo6;

interface

uses
  { Standard }
  Classes, Types, SysUtils,
  { TypeInfo }
  TypInfo,
  { XML }
  XMLDoc, XMLIntf,
  { Next Standard 6 }
  NxIntf6;

procedure ResolveProperty(var Ref: TObject; var PropName: string);

procedure GetPropValue(Instance: TObject; PropName: string; Value: INxBase);
procedure SetPropValue(Instance: TObject; PropName: string; Value: INxBase);

implementation

uses
  Dialogs;

procedure ResolveProperty(var Ref: TObject;
  var PropName: string);
var
  DotPos: Integer;
  RefClass: TClass;
  RefName: string;
begin
  if Assigned(Ref)
    and (PropName <> EmptyStr) then
  begin
    { Get Dot Char Pos. }
    DotPos := Pos('.', PropName);

    { Is SubProperty? }
    if DotPos > 0 then
    begin
      RefName := Copy(PropName, 1, Pred(DotPos));

      { Delete "." Char }
      Delete(PropName, 1, DotPos);

      RefClass := GetObjectPropClass(Ref, RefName);

      Ref := GetObjectProp(Ref, RefName, RefClass);

      { Recursion }
      ResolveProperty(Ref, PropName);
    end;
  end;

end;

procedure GetPropValue(Instance: TObject; PropName: string; Value: INxBase);
var
	PropInfo: PPropInfo;
  Ref: TObject;
begin

  if Assigned(Instance) then
  begin
    Ref := Instance;

    { Isolate Obj. & Property }
    ResolveProperty(Ref, PropName);

    { Read Info }
    PropInfo := GetPropInfo(Ref, PropName);

    if Assigned(PropInfo) then
    begin

      { Prop. Kind }
      case PropInfo^.PropType^.Kind of
        { String & WideString }
        {$IFDEF UNICODE}tkUString, {$ENDIF}
        tkString,
        tkLString: Value.AsString := GetStrProp(Ref, PropName);
        tkWString: Value.AsString := {$IFDEF UNICODE}GetStrProp{$ELSE}GetWideStrProp{$ENDIF}(Ref, PropName);
        { Other }
        tkInteger: Value.AsInteger := GetOrdProp(Ref, PropName);
        tkFloat: Value.AsFloat := GetFloatProp(Ref, PropName);
        tkEnumeration: Value.AsString := GetEnumProp(Ref, PropName);
        tkSet: Value.AsString := GetSetProp(Ref, PropName);
      end;

    end; { if Assigned PropInfo }

  end; { if Assigned Instance }

end;

procedure SetPropValue(Instance: TObject; PropName: string; Value: INxBase);
var
	PropInfo: PPropInfo;
  Ref: TObject;
begin

  if Assigned(Instance) then
  begin
    Ref := Instance;

    { Isolate Obj. & Property }
    ResolveProperty(Ref, PropName);

    { Read Info }
    PropInfo := GetPropInfo(Ref, PropName);

    if Assigned(PropInfo) then
    begin

      { Prop. Kind }
      case PropInfo^.PropType^.Kind of
        { String & WideString }
        {$IFDEF UNICODE}tkUString, tkWString,{$ENDIF}
        tkString,
        tkLString: SetStrProp(Ref, PropName, Value.AsString);
        {$IFNDEF UNICODE}
        tkWString: SetWideStrProp(Ref, PropName, Value.AsString);
        {$ENDIF}
        { Other }
        tkInteger: SetOrdProp(Ref, PropName, Value.AsInteger);
        tkFloat: SetFloatProp(Ref, PropName, Value.AsFloat);
        tkEnumeration: SetEnumProp(Ref, PropName, Value.AsString);
        tkSet: SetSetProp(Ref, PropName, Value.AsString); { Error ! }
      end;

    end; { if Assigned PropInfo }

  end; { if Assigned Instance }

end;

end.
