GetTypeData（）。FloatType在FPC在mvframework不編譯

在http://leonardorame.blogspot.com.ar/2009_11_01_archive.html鏈接討論如何實現與FPC兼容的框架，但單位MvFrameworkSrvProvider.pas線54，我解決不了以下問題：GetTypeData（）。FloatType在FPC在mvframework不編譯

case GetTypeData(PropInfo^.PropType).FloatType of

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

誰能幫我這個好嗎？

在此先感謝。 Gabriel

完整的代碼在這裏： P.S: .:對不起，我嘗試正確標記代碼，但我不知道如何做。

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.

來源

2012-07-28 Gabriel Silva

來自fpc源的AFAICS，它只能在typinfo編譯爲'FPUNONE'未定義時才能編譯。我不知道FPUNONE定義的是什麼。 – 2012-07-28 13:42:59

我試圖只把這個代碼，但不起作用：「case GetTypeData（PropInfo^.PropType）.FloatType」因爲，只有我需要使用FPC +拉撒路然後我不需要使用條件指令。 – 2012-07-28 14:38:33

我正在測試解決方案，謝謝！ – 2012-07-28 16:17:10

代碼需要在delphi兼容模式下明顯編譯。在單元的開頭添加{$mode delphi}或者用命令行開關-Sd編譯。

來源

2012-07-28 15:08:59 FPK

我正在測試解決方案，謝謝！ – 2012-07-28 16:16:53

GetTypeData（）。FloatType在FPC在mvframework不編譯

回答

相關問題