paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patch from José Mejuto to fix bug ID #27486

Browse Source 
git-svn-id: trunk@32823 -
This commit is contained in:
michael 2016-01-01 17:10:30 +00:00
parent 9111c9263e
commit ca2b1f97ed
1 changed files with 39 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
packages/winunits-base/src/typelib.pas
View File

@ -466,6 +466,7 @@ var
VD: lpVARDESC;
aPropertyDefs:array of TPropertyDef;
Propertycnt,iType:integer;
Modifier: string;
function findProperty(ireqdispid:integer):integer;
var i:integer;
@ -545,11 +546,18 @@ begin
OleCheck(TI.GetNames(FD^.memid,@BL,length(BL),cnt));
// skip IUnknown and IDispatch methods
sl:=lowercase(BL[0]);
if (sl='queryinterface') or (sl='addref') or (sl='release') then //IUnknown
(*************************
* Code portion removed by José Mejuto.
* If the interface declaration appears in the TLB it must be imported
* or the sequences of functions will be broken and any function below this
* point would be called wrongly.
*************************
if ((sl='queryinterface') or (sl='addref') or (sl='release')) then //IUnknown
continue;
if bIsDispatch and
((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then //IDispatch
continue;
*)
// get return type
if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
begin
@ -761,6 +769,8 @@ begin
begin
//getters/setters for interface, insert in interface as they come,
//store in aPropertyDefs to create properties at the end
bParamByRef:=(FD^.lprgelemdescParam[0].tdesc.vt=VT_PTR) and // by ref
not((FD^.lprgelemdescParam[0].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface
if bPropHasParam then
begin
sPropParam2:='('+sPropParam+')';
@ -785,37 +795,41 @@ begin
begin
if not MakeValidId(GetName(1),sVarName) then
AddToHeader('// Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[GetName(1),iname,sMethodName,sVarName]);
with aPropertyDefs[findProperty(FD^.memid)] do
if not bParamByRef then
begin
if FD^.invkind=INVOKE_PROPERTYPUT then
with aPropertyDefs[findProperty(FD^.memid)] do
begin
sptype:=sType;
bput:=true;
if bputref then //disambiguate multiple setter
sMethodName:=sMethodName+'_';
pname:=sMethodName;
end
else
begin
sprtype:=sType;
bputref:=true;
if bput then //disambiguate multiple setter
sMethodName:=sMethodName+'_';
prname:=sMethodName;
if FD^.invkind=INVOKE_PROPERTYPUT then
begin
sptype:=sType;
bput:=true;
if bputref then //disambiguate multiple setter
sMethodName:=sMethodName+'_';
pname:=sMethodName;
end
else
begin
sprtype:=sType;
bputref:=true;
if bput then //disambiguate multiple setter
sMethodName:=sMethodName+'_';
prname:=sMethodName;
end;
sorgname:=BstrName;
sdoc:=BstrDocString;
sParam:=sPropParam;
sDefault:=sl;
end;
sorgname:=BstrName;
sdoc:=BstrDocString;
sParam:=sPropParam;
sDefault:=sl;
end;
if sType='OleVariant' then
tmp:=' procedure Set_%s(%s:%s); %s;'#13#10
tmp:=' procedure Set_%s(%s %s:%s); %s;'#13#10;
if not (bParamByRef or (sType='OleVariant')) then
Modifier:='const'
else
tmp:=' procedure Set_%s(Const %s:%s); %s;'#13#10;
Modifier:='var';
if bPropHasParam then
s:=s+format(tmp,[sMethodName,sPropParam3,sType,sConv])
s:=s+format(tmp,[sMethodName,Modifier,sPropParam3,sType,sConv])
else
s:=s+format(tmp,[sMethodName,sVarName,sType,sConv]);
s:=s+format(tmp,[sMethodName,Modifier,sVarName,sType,sConv]);
end;
end;
end;