paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 03:19:55 +01:00
Code Issues Packages Projects Releases Wiki Activity

IdeIntf: propedits: fix call stored method with index parameter if needed. Issue #31923

Browse Source 
git-svn-id: trunk@55098 -
This commit is contained in:
ondrej 2017-05-26 11:50:41 +00:00
parent 626736e5e2
commit a08eb48d76
1 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/ideintf/propedits.pp
View File

@ -2554,10 +2554,12 @@ end;
type
TBoolFunc = function: Boolean of object;
TBoolIndexFunc = function(const Index: Integer): Boolean of object;
function TPropertyEditor.CallStoredFunction: Boolean;
var
Func: TMethod;
FFunc: TBoolFunc;
Met: TMethod;
Func: TBoolFunc;
IndexFunc: TBoolIndexFunc;
APropInfo: PPropInfo;
StoredProcType: Byte;
begin
@ -2566,14 +2568,21 @@ begin
if StoredProcType in [ptStatic, ptVirtual] then
begin
case StoredProcType of
ptStatic: Func.Code := APropInfo^.StoredProc;
ptVirtual: Func.Code := PPointer(Pointer(FPropList^[0].Instance.ClassType))[{%H-}PtrInt(APropInfo^.StoredProc) div SizeOf(Pointer)];
ptStatic: Met.Code := APropInfo^.StoredProc;
ptVirtual: Met.Code := PPointer(Pointer(FPropList^[0].Instance.ClassType))[{%H-}PtrInt(APropInfo^.StoredProc) div SizeOf(Pointer)];
end;
if Func.Code = nil then
if Met.Code = nil then
raise EPropertyError.Create('No property stored method available');
Func.Data := FPropList^[0].Instance;
FFunc := TBoolFunc(Func);
Result := FFunc();
Met.Data := FPropList^[0].Instance;
if ((APropInfo^.PropProcs shr 6) and 1) <> 0 then // has index property
begin
IndexFunc := TBoolIndexFunc(Met);
Result := IndexFunc(APropInfo^.Index);
end else
begin
Func := TBoolFunc(Met);
Result := Func();
end;
end else
if StoredProcType = ptConst then
Result := APropInfo^.StoredProc<>nil