GetTypeData().FloatType in FPC in a mvframework don't compile
===

In the <http://leonardorame.blogspot.com.ar/2009_11_01_archive.html> link discusses how to implement a framework compatible with **FPC**, but the line 54 of the unit MvFrameworkSrvProvider.pas, I can not solve the following problem:

<code>
case GetTypeData(PropInfo^.PropType).**FloatType** of
</code>

    "MvFrameworkSrvProvider.pas (54.57) Error: Illegal qualifier"

Could anyone help me with this please?

Thanks in advance.
Gabriel


The complete code here:
P.S.: Sorry, I try to mark correctly the code but i don't know how-to.

    unit MvFrameworkSrvProvider;
    
    interface
    
    
    uses
      SysUtils,
      Classes,
      TypInfo,
      Variants;
    
    type
      TMVSrvProvider = class
      public
        function GetValueFromProperty(AClass: TObject; APropertyName: string): Variant;
        procedure SetValueToProperty(AClass: TObject; APropertyName: string;
          const Value: Variant);
      end;
    
    implementation
    
    uses
      StrUtils;
    
    function TMVSrvProvider.GetValueFromProperty(AClass: TObject;
      APropertyName: string): Variant;
    (* Get property value *)
    var
      PropInfo: PPropInfo;
      lFloatProp: Extended;
    begin
      (* Get property info *)
      Result := Null;
      try
        PropInfo := GetPropInfo(AClass, APropertyName);
        if PropInfo <> nil then
        begin
          case PropInfo^.PropType^.Kind of
            (* String types *)
            tkChar:
              Result := Char(GetOrdProp(AClass, APropertyName));
    {$IFDEF Unicode}
            tkUString: Result := GetUnicodeStrProp(AClass, APropertyName);
    {$ENDIF}
            tkWString, tkLString, tkString:
              Result := GetStrProp(AClass, APropertyName);
            (* Float types *)
            tkFloat:
              begin
                (* Every float type has its own subtype ex. TDateTime *)
    
                lFloatProp := GetFloatProp(AClass, APropertyName);
    
                {$IFDEF fpc}
                       case GetTypeData(PropInfo^.PropType).FloatType of
                {$ELSE}
                       case GetTypeData(PropInfo^.PropType^).FloatType of
                {$ENDIF}
    
                  ftSingle:
                    Result := VarAsType(lFloatProp, varSingle);
                  ftDouble, ftExtended, ftComp:
                    Result := VarAsType(lFloatProp, varDouble);
                  ftCurr:
                    Result := FloatToCurr(lFloatProp);
                end;
                  (* Hard format TDateTime *)
                if UpperCase(PropInfo^.PropType^.Name) = UpperCase('TDateTime')
                  then
                  Result := TVarData(Result).VDate
                else if UpperCase(PropInfo^.PropType^.Name) = UpperCase('TDate')
                  then
                  Result := StrToDate(DateToStr(TVarData(Result).VDate));
              end;
                (* Integer types *)
            tkEnumeration:
              Result := GetOrdProp(AClass, APropertyName);
            tkInteger:
              Result := GetOrdProp(AClass, APropertyName);
                (* Classes *)
            tkClass:
              Result := Integer(GetObjectProp(AClass, APropertyName));
          else
            Result := GetPropValue(AClass, APropertyName, False);
          end;
        end;
      except
        Result := Null;
      end;
    end;
    
    procedure TMVSrvProvider.SetValueToProperty(AClass: TObject;
      APropertyName: string; const Value: Variant);
    (* Assign values to properties *)
    type
      (* Method pointers *)
      TStringSetProc = procedure(const Value: string) of object;
      TShortStringSetProc = procedure(const Value: ShortString) of object;
      TIntegerSetProc = procedure(const Value: Integer) of object;
      TVariantSetProc = procedure(const Value: Variant) of object;
      TExtendedSetProc = procedure(const Value: Extended) of object;
      TSingleSetProc = procedure(const Value: Single) of object;
      TDoubleSetProc = procedure(const Value: Double) of object;
      TCompSetProc = procedure(const Value: Comp) of object;
      TCurrencySetProc = procedure(const Value: Currency) of object;
      TCharSetProc = procedure(const Value: Char) of object;
      TClassSetProc = procedure(const Value: Integer) of object;
    
    type
      (* Index methods *)
      TVariantIndexedSetProc = procedure(Index: Integer; const Value: Variant)
        of object;
      TIntegerIndexedSetProc = procedure(Index: Integer; const Value: Integer)
        of object;
      TStringIndexedSetProc = procedure(Index: Integer; const Value: string)
        of object;
      TShortStringIndexedSetProc = procedure(Index: Integer;
        const Value: ShortString) of object;
      TSingleIndexedSetProc = procedure(Index: Integer; const Value: Single)
        of object;
      TDoubleIndexedSetProc = procedure(Index: Integer; const Value: Double)
        of object;
      TExtendedIndexedSetProc = procedure(Index: Integer; const Value: Extended)
        of object;
      TCompIndexedSetProc = procedure(Index: Integer; const Value: Comp) of object;
      TCurrencyIndexedSetProc = procedure(Index: Integer; const Value: Currency)
        of object;
      TCharIndexSetProc = procedure(Index: Integer; const Value: Char) of object;
      TObjectIndexSetProc = procedure(Index: Integer; const Value: Integer)
        of object;
    
    type
      PUChar = ^Char;
    {$IFNDEF DELPHI70}
      PInteger = ^Integer;
      PSingle = ^Single;
      PDouble = ^Double;
      PComp = ^Comp;
    {$ENDIF}
    const
    {$IFDEF FPC}
      NilValue = Pointer($01);
    {$ELSE}
      NilValue = nil;
    {$ENDIF}
    var
      M: TMethod;
      PProperty: Longint;
      PMethod: Longint;
      PropInfo: PPropInfo;
      P: Pointer;
      lValue: Variant;
    
    begin
      (* First, get property info *)
      PropInfo := GetPropInfo(AClass, APropertyName);
    
      (* If we can't get property info, then exit *)
      if PropInfo = nil then
        Exit;
    
      (* Initialization *)
      PProperty := 0;
    
      // PMethod   := 0;
    
      (* Get memory addresses of SetProc and GetProc *)
      if PropInfo^.SetProc <> NilValue then
        PMethod := Longint(PropInfo^.SetProc)
      else
        Exit;
    
      if PropInfo^.GetProc <> NilValue then
        PProperty := Longint(PropInfo^.GetProc);
    
      (* Segun el tipo de datos procesamos primero los ReadOnly escribiendo en la variable *)
      (* Obtenemos el offset $00FFFFFF de la instancia + el desplazamiento de la variable *)
      (* Luego escribimos en la direccion obtenida en forma directa - si el metodo es una *)
      (* variable tambien los escribe = ((PMethod and $FF000000) = $FF000000)) *)
      (* Si es un metodo indexado tambien lo escribe aqui *)
    
      lValue := Value;
    
      if ((PropInfo^.SetProc = NilValue) and (PropInfo^.GetProc <> NilValue) and
        not ((PMethod and $FF000000) = $FF000000)) or (PropInfo^.SetProc = PropInfo^.GetProc) then
      begin
        (* Direccion de desplazamiento *)
        P := Pointer(Integer(AClass) + (PProperty and $00FFFFFF));
    
        (* Escribimos el valor *)
        case PropInfo^.PropType^.Kind of
          tkString: PShortString(P)^ := VarToStr(lValue);
          tkLString, tkWString: PString(P)^ := VarToStr(lValue);
    {$IFDEF UNICODE}
          tkUString: PString(P)^ := VarToStr(lValue);
    {$ENDIF}
    {$IFDEF FPC}
          tkAString: PString(P)^ := VarToStr(lValue);
    {$ENDIF}
          tkInt64, tkInteger, tkEnumeration:
            begin
              if VarIsNull(lValue) or VarIsEmpty(lValue) or (lValue = '') then
                lValue := 0;
    
              if UpperCase(PropInfo^.PropType^.Name) = 'BOOLEAN' then
                PByte(P)^ := lValue
              else
                PInteger(P)^ := lValue;
            end;
    
          tkVariant:
            begin
              if VarIsNull(lValue) then
                PVariant(P)^ := Null
              else
                PVariant(P)^ := lValue;
            end;
          tkClass: PInteger(P)^ := lValue;
          tkChar:
            begin
              if string(lValue) <> '' then
                PUChar(P)^ := string(lValue)[1]
              else
                PUChar(P)^ := #0;
            end;
    
          tkFloat:
            begin
              if VarIsNull(lValue) or VarIsEmpty(lValue) then //or (lValue = '')then
                lValue := 0;
    
            (* Cada tipo float tiene su formato especial asi com tipos ej. TDateTime ver TypInfo *)
            (* Aplicamos el tipo de float que corresponda *)
    {$IFDEF fpc}
              case GetTypeData(PropInfo^.PropType).FloatType of
    {$ELSE}
              case GetTypeData(PropInfo^.PropType^).FloatType of
    {$ENDIF}
                ftSingle: PSingle(P)^ := VarAsType(lValue, varSingle);
                ftDouble: PDouble(P)^ := VarAsType(lValue, varDouble);
                ftExtended: PExtended(P)^ := VarAsType(lValue, varSingle);
                ftComp: PComp(P)^ := VarAsType(lValue, varSingle);
                ftCurr: PCurrency(P)^ := VarAsType(lValue, varSingle);
              end;
            end;
        end;
          (* All is ok *)
        Exit;
      end;
    
      (* Procesamos aquellos que posean un metodo convencional que no sean variable *)
      if not ((PMethod and $FF000000) = $FF000000) then
        //if (PropInfo^.SetProc <> NilValue) then
        begin
          (* Obtenemos la clase de matodo 1- Metodo virtual 2- metodo convencional *)
          (* Varian el primero del segundo en el desplazamiento VMT (Virtual method table ) *)
          if (PMethod and $FF000000) = $FE000000 then
            M.Code := Pointer(PInteger(PInteger(AClass)^ + SmallInt(PMethod))^)
          else
            M.Code := Pointer(PMethod);
    
          (* Completamos con la instancia *)
          M.Data := AClass;
    
          (* Dependiendo del tipo de datos lo ejecutamos el metodo *)
          if PropInfo^.Index = Integer($80000000) then // (* Si no posee indice *)
            case PropInfo^.PropType^.Kind of
              tkString:
                TShortStringSetProc(M)(VarToStr(lValue));
              tkLString, tkWString:
                TStringSetProc(M)(VarToStr(lValue));
    {$IFDEF FPC}
              tkAString:
                TStringSetProc(M)(VarToStr(lValue));
    {$ENDIF}
              tkInteger, tkInt64, tkEnumeration:
                begin
                  if VarIsNull(lValue) then
                    lValue := 0;
                  TIntegerSetProc(M)(lValue);
                end;
    
              tkVariant:
                begin
                  if VarIsNull(lValue) then
                    TVariantSetProc(M)(Null)
                  else
                    TVariantSetProc(M)(lValue);
                end;
    
              tkChar:
                if string(lValue) <> '' then
                  TCharSetProc(M)(string(lValue)[1])
                else
                  TCharSetProc(M)(#0);
    
              tkClass:
                TClassSetProc(M)(Integer(lValue));
              tkFloat:
            (* Tipos de datos flotantes *)
    {$IFDEF fpc}
                case GetTypeData(PropInfo^.PropType).FloatType of
    {$ELSE}
                case GetTypeData(PropInfo^.PropType^).FloatType of
    {$ENDIF}
                  ftSingle:
                    begin
                      if VarIsNull(lValue) then
                        lValue := 0;
                      TSingleSetProc(M)(lValue);
                    end;
                  ftDouble:
                    begin
                      if VarIsNull(lValue) then
                        lValue := 0;
                      TDoubleSetProc(M)(lValue);
                    end;
    
                  ftExtended:
                    begin
                      if VarIsNull(lValue) then
                        lValue := 0;
                      TExtendedSetProc(M)(lValue);
                    end;
    
                  ftComp:
                    begin
                      if VarIsNull(lValue) then
                        lValue := 0;
                      TCompSetProc(M)(lValue);
                    end;
                  ftCurr:
                    begin
                      if VarIsNull(lValue) then
                        lValue := 0;
                      TCurrencySetProc(M)(lValue);
                    end;
                end; // case
            end // case
          else // if
            case PropInfo^.PropType^.Kind of
              tkString:
                TShortStringIndexedSetProc(M)(PropInfo^.Index, lValue);
              tkLString, tkWString:
                TStringIndexedSetProc(M)(PropInfo^.Index, lValue);
              tkInteger, tkInt64,
              tkEnumeration:
                TIntegerIndexedSetProc(M)(PropInfo^.Index, lValue);
              tkVariant:
                TVariantIndexedSetProc(M)(PropInfo^.Index, lValue);
              tkChar:
                TCharIndexSetProc(M)(PropInfo^.Index, string(lValue)[1]);
              tkClass:
                TObjectIndexSetProc(M)(PropInfo^.Index, Integer(lValue));
              tkFloat:
                (* Segun el tipo de real *)
    {$IFDEF fpc}
                case GetTypeData(PropInfo^.PropType).FloatType of
    {$ELSE}
                case GetTypeData(PropInfo^.PropType^).FloatType of
    {$ENDIF}
                  ftSingle:
                    TSingleIndexedSetProc(M)(PropInfo^.Index, lValue);
                  ftDouble:
                    TDoubleIndexedSetProc(M)(PropInfo^.Index, lValue);
                  ftExtended:
                    TExtendedIndexedSetProc(M)(PropInfo^.Index, lValue);
                  ftComp:
                    TCompIndexedSetProc(M)(PropInfo^.Index, lValue);
                  ftCurr:
                    TCurrencyIndexedSetProc(M)(PropInfo^.Index, lValue);
                end; // case
            end // case
        end; // if
    end;
    
    end.

