paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 19:10:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r32858 into '.':

Browse Source 
U    packages/rtl-objpas/src/inc/variants.pp
U    rtl/objpas/typinfo.pp
--- Recording mergeinfo for merge of r32858 into '.':
 U   .
--- Merging r32863 into '.':
G    packages/rtl-objpas/src/inc/variants.pp
--- Recording mergeinfo for merge of r32863 into '.':
 G   .

# revisions: 32858,32863

git-svn-id: branches/fixes_3_0@33822 -
This commit is contained in:
marco 2016-05-26 16:55:26 +00:00
parent d5cb60b1a3
commit a57e3d1682
2 changed files with 147 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
packages/rtl-objpas/src/inc/variants.pp
View File

@ -342,9 +342,8 @@ const
{ Typinfo unit Variant routines have been moved here, so as not to make TypInfo dependent on variants } { Typinfo unit Variant routines have been moved here, so as not to make TypInfo dependent on variants }
Function GetPropValue(Instance: TObject; const PropName: string): Variant; Function GetPropValue(Instance: TObject; PropInfo: PPropInfo; PreferStrings: Boolean): Variant; overload;
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant; Procedure SetPropValue(Instance: TObject; PropInfo: PPropInfo; const Value: Variant); overload;
Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant; Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant;
Function GetVariantProp(Instance: TObject; const PropName: string): Variant; Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant); Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
@ -4169,14 +4168,14 @@ function TInvokeableVariantType.SetProperty(var V: TVarData; const Name: string;
function TPublishableVariantType.GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean; function TPublishableVariantType.GetProperty(var Dest: TVarData; const V: TVarData; const Name: string): Boolean;
begin begin
Result:=true; Result:=true;
Variant(Dest):=GetPropValue(getinstance(v),name); Variant(Dest):=TypInfo.GetPropValue(getinstance(v),name);
end; end;
function TPublishableVariantType.SetProperty(var V: TVarData; const Name: string; const Value: TVarData): Boolean; function TPublishableVariantType.SetProperty(var V: TVarData; const Name: string; const Value: TVarData): Boolean;
begin begin
Result:=true; Result:=true;
SetPropValue(getinstance(v),name,Variant(value)); TypInfo.SetPropValue(getinstance(v),name,Variant(value));
end; end;
@ -4497,65 +4496,54 @@ end;
Function GetPropValue(Instance: TObject; const PropName: string): Variant; Function GetPropValue(Instance: TObject; const PropName: string): Variant;
begin begin
Result:=GetPropValue(Instance,PropName,True); Result:=TypInfo.GetPropValue(Instance,PropName,True);
end; end;
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant; Function GetPropValue(Instance: TObject; PropInfo: PPropInfo; PreferStrings: Boolean): Variant;
var
PropInfo: PPropInfo;
begin begin
// find the property Result := Null; //at worst
PropInfo := GetPropInfo(Instance, PropName); // call the Right GetxxxProp
if PropInfo = nil then case PropInfo^.PropType^.Kind of
raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]) tkInteger, tkChar, tkWChar, tkClass, tkBool:
else Result := GetOrdProp(Instance, PropInfo);
begin tkEnumeration:
Result := Null; //at worst if PreferStrings then
// call the Right GetxxxProp Result := GetEnumProp(Instance, PropInfo)
case PropInfo^.PropType^.Kind of else
tkInteger, tkChar, tkWChar, tkClass, tkBool: Result := GetOrdProp(Instance, PropInfo);
tkSet:
if PreferStrings then
Result := GetSetProp(Instance, PropInfo, False)
else
Result := GetOrdProp(Instance, PropInfo); Result := GetOrdProp(Instance, PropInfo);
tkEnumeration:
if PreferStrings then
Result := GetEnumProp(Instance, PropInfo)
else
Result := GetOrdProp(Instance, PropInfo);
tkSet:
if PreferStrings then
Result := GetSetProp(Instance, PropInfo, False)
else
Result := GetOrdProp(Instance, PropInfo);
{$ifndef FPUNONE} {$ifndef FPUNONE}
tkFloat: tkFloat:
Result := GetFloatProp(Instance, PropInfo); Result := GetFloatProp(Instance, PropInfo);
{$endif} {$endif}
tkMethod: tkMethod:
Result := PropInfo^.PropType^.Name; Result := PropInfo^.PropType^.Name;
tkString, tkLString, tkAString: tkString, tkLString, tkAString:
Result := GetStrProp(Instance, PropInfo); Result := GetStrProp(Instance, PropInfo);
tkWString: tkWString:
Result := GetWideStrProp(Instance, PropInfo); Result := GetWideStrProp(Instance, PropInfo);
tkUString: tkUString:
Result := GetUnicodeStrProp(Instance, PropInfo); Result := GetUnicodeStrProp(Instance, PropInfo);
tkVariant: tkVariant:
Result := GetVariantProp(Instance, PropInfo); Result := GetVariantProp(Instance, PropInfo);
tkInt64: tkInt64:
Result := GetInt64Prop(Instance, PropInfo); Result := GetInt64Prop(Instance, PropInfo);
tkQWord: tkQWord:
Result := QWord(GetInt64Prop(Instance, PropInfo)); Result := QWord(GetInt64Prop(Instance, PropInfo));
else else
raise EPropertyConvertError.CreateFmt('Invalid Property Type: %s',[PropInfo^.PropType^.Name]); raise EPropertyConvertError.CreateFmt('Invalid Property Type: %s',[PropInfo^.PropType^.Name]);
end; end;
end;
end; end;
Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant); Procedure SetPropValue(Instance: TObject; PropInfo: PPropInfo; const Value: Variant);
var var
PropInfo: PPropInfo;
TypeData: PTypeData; TypeData: PTypeData;
O: Integer; O: Integer;
I64: Int64; I64: Int64;
@ -4564,103 +4552,96 @@ var
B: Boolean; B: Boolean;
begin begin
// find the property TypeData := GetTypeData(PropInfo^.PropType);
PropInfo := GetPropInfo(Instance, PropName); // call Right SetxxxProp
if PropInfo = nil then case PropInfo^.PropType^.Kind of
raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]) tkBool:
else begin
begin { to support the strings 'true' and 'false' }
TypeData := GetTypeData(PropInfo^.PropType); if (VarType(Value)=varOleStr) or
// call Right SetxxxProp (VarType(Value)=varString) or
case PropInfo^.PropType^.Kind of (VarType(Value)=varBoolean) then
tkBool:
begin begin
{ to support the strings 'true' and 'false' } B:=Value;
if (VarType(Value)=varOleStr) or SetOrdProp(Instance, PropInfo, ord(B));
(VarType(Value)=varString) or end
(VarType(Value)=varBoolean) then else
begin
B:=Value;
SetOrdProp(Instance, PropInfo, ord(B));
end
else
begin
I64:=Value;
if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then
raise ERangeError.Create(SRangeError);
SetOrdProp(Instance, PropInfo, I64);
end;
end;
tkInteger, tkChar, tkWChar:
begin begin
I64:=Value;
if (TypeData^.OrdType=otULong) then
if (I64<LongWord(TypeData^.MinValue)) or (I64>LongWord(TypeData^.MaxValue)) then
raise ERangeError.Create(SRangeError)
else
else
if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then
raise ERangeError.Create(SRangeError);
SetOrdProp(Instance, PropInfo, I64);
end;
tkEnumeration :
begin
if (VarType(Value)=varOleStr) or (VarType(Value)=varString) then
begin
S:=Value;
SetEnumProp(Instance,PropInfo,S);
end
else
begin
I64:=Value; I64:=Value;
if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then
raise ERangeError.Create(SRangeError); raise ERangeError.Create(SRangeError);
SetOrdProp(Instance, PropInfo, I64); SetOrdProp(Instance, PropInfo, I64);
end;
end; end;
tkSet : end;
begin tkInteger, tkChar, tkWChar:
if (VarType(Value)=varOleStr) or (VarType(Value)=varString) then begin
begin I64:=Value;
S:=Value; if (TypeData^.OrdType=otULong) then
SetSetProp(Instance,PropInfo,S); if (I64<LongWord(TypeData^.MinValue)) or (I64>LongWord(TypeData^.MaxValue)) then
end raise ERangeError.Create(SRangeError)
else else
begin else
O:=Value; if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then
SetOrdProp(Instance, PropInfo, O); raise ERangeError.Create(SRangeError);
end; SetOrdProp(Instance, PropInfo, I64);
end; end;
{$ifndef FPUNONE} tkEnumeration :
tkFloat: begin
SetFloatProp(Instance, PropInfo, Value); if (VarType(Value)=varOleStr) or (VarType(Value)=varString) then
{$endif}
tkString, tkLString, tkAString:
SetStrProp(Instance, PropInfo, VarToStr(Value));
tkWString:
SetWideStrProp(Instance, PropInfo, VarToWideStr(Value));
tkUString:
SetUnicodeStrProp(Instance, PropInfo, VarToUnicodeStr(Value));
tkVariant:
SetVariantProp(Instance, PropInfo, Value);
tkInt64:
begin begin
I64:=Value; S:=Value;
if (I64<TypeData^.MinInt64Value) or (I64>TypeData^.MaxInt64Value) then SetEnumProp(Instance,PropInfo,S);
raise ERangeError.Create(SRangeError);
SetInt64Prop(Instance, PropInfo, I64);
end;
tkQWord:
begin
Qw:=Value;
if (Qw<TypeData^.MinQWordValue) or (Qw>TypeData^.MaxQWordValue) then
raise ERangeError.Create(SRangeError);
SetInt64Prop(Instance, PropInfo,Qw);
end end
else else
raise EPropertyConvertError.CreateFmt('SetPropValue: Invalid Property Type %s', begin
[PropInfo^.PropType^.Name]); I64:=Value;
end; if (I64<TypeData^.MinValue) or (I64>TypeData^.MaxValue) then
raise ERangeError.Create(SRangeError);
SetOrdProp(Instance, PropInfo, I64);
end;
end;
tkSet :
begin
if (VarType(Value)=varOleStr) or (VarType(Value)=varString) then
begin
S:=Value;
SetSetProp(Instance,PropInfo,S);
end
else
begin
O:=Value;
SetOrdProp(Instance, PropInfo, O);
end;
end;
{$ifndef FPUNONE}
tkFloat:
SetFloatProp(Instance, PropInfo, Value);
{$endif}
tkString, tkLString, tkAString:
SetStrProp(Instance, PropInfo, VarToStr(Value));
tkWString:
SetWideStrProp(Instance, PropInfo, VarToWideStr(Value));
tkUString:
SetUnicodeStrProp(Instance, PropInfo, VarToUnicodeStr(Value));
tkVariant:
SetVariantProp(Instance, PropInfo, Value);
tkInt64:
begin
I64:=Value;
if (I64<TypeData^.MinInt64Value) or (I64>TypeData^.MaxInt64Value) then
raise ERangeError.Create(SRangeError);
SetInt64Prop(Instance, PropInfo, I64);
end;
tkQWord:
begin
Qw:=Value;
if (Qw<TypeData^.MinQWordValue) or (Qw>TypeData^.MaxQWordValue) then
raise ERangeError.Create(SRangeError);
SetInt64Prop(Instance, PropInfo,Qw);
end
else
raise EPropertyConvertError.CreateFmt('SetPropValue: Invalid Property Type %s',
[PropInfo^.PropType^.Name]);
end; end;
end; end;

35
rtl/objpas/typinfo.pp
View File

@ -401,7 +401,10 @@ Procedure SetInt64Prop(Instance: TObject; const PropName: string; const Value:
Function GetPropValue(Instance: TObject; const PropName: string): Variant; Function GetPropValue(Instance: TObject; const PropName: string): Variant;
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant; Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
Function GetPropValue(Instance: TObject; PropInfo: PPropInfo): Variant;
Function GetPropValue(Instance: TObject; PropInfo: PPropInfo; PreferStrings: Boolean): Variant;
Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant); Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
Procedure SetPropValue(Instance: TObject; PropInfo: PPropInfo; const Value: Variant);
Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant; Function GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant;
Function GetVariantProp(Instance: TObject; const PropName: string): Variant; Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant); Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
@ -434,8 +437,8 @@ const
Type Type
EPropertyError = Class(Exception); EPropertyError = Class(Exception);
TGetPropValue = Function (Instance: TObject; const PropName: string; PreferStrings: Boolean) : Variant; TGetPropValue = Function (Instance: TObject; PropInfo: PPropInfo; PreferStrings: Boolean) : Variant;
TSetPropValue = Procedure (Instance: TObject; const PropName: string; const Value: Variant); TSetPropValue = Procedure (Instance: TObject; PropInfo: PPropInfo; const Value: Variant);
TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant; TGetVariantProp = Function (Instance: TObject; PropInfo : PPropInfo): Variant;
TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant); TSetVariantProp = Procedure (Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
@ -1989,22 +1992,38 @@ end;
Function GetPropValue(Instance: TObject; const PropName: string): Variant; Function GetPropValue(Instance: TObject; const PropName: string): Variant;
begin begin
Result:=GetPropValue(Instance,PropName,True); Result := GetPropValue(Instance,FindPropInfo(Instance, PropName));
end; end;
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant; Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
begin begin
CheckVariantEvent(CodePointer(OnGetPropValue)); Result := GetPropValue(Instance,FindPropInfo(Instance, PropName),PreferStrings);
Result:=OnGetPropValue(Instance,PropName,PreferStrings) end;
Function GetPropValue(Instance: TObject; PropInfo: PPropInfo): Variant;
begin
Result := GetPropValue(Instance, PropInfo, True);
end;
Function GetPropValue(Instance: TObject; PropInfo: PPropInfo; PreferStrings: Boolean): Variant;
begin
CheckVariantEvent(Pointer(OnGetPropValue));
Result:=OnGetPropValue(Instance,PropInfo,PreferStrings);
end; end;
Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant); Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
begin begin
CheckVariantEvent(CodePointer(OnSetPropValue)); SetPropValue(Instance, FindPropInfo(Instance, PropName), Value);
OnSetPropValue(Instance,PropName,Value); end;
Procedure SetPropValue(Instance: TObject; PropInfo: PPropInfo; const Value: Variant);
begin
CheckVariantEvent(Pointer(OnSetPropValue));
OnSetPropValue(Instance,PropInfo,Value);
end; end;