blob: ce2a146ae297902f7cf0340e893ebc1266ff349e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{$mode delphi}
uses
Classes, SysUtils;
type
ITest = interface ['{AAAA09DA-4019-4A5C-A450-3631A73CF288}']
function TestIt: integer;
end;
TTestBE = class (TObject, ITest)
function TestIt: integer;
{ IInterface }
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
End;
TTest = class (TPersistent, IInterface)
BE : TTestBE;
protected
{ IInterface }
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
End;
function TTestBE.TestIt : integer;
Begin
result := 1;
End;
function TTest._AddRef: Integer;
begin
Result := -1;
end;
function TTest._Release: Integer;
begin
Result := -1;
end;
function TTest.QueryInterface(constref IID: TGUID; out Obj): HResult;
begin
Result := BE.QueryInterface(IID, obj);
end;
function TTestBE._AddRef: Integer;
begin
Result := -1;
end;
function TTestBE._Release: Integer;
begin
Result := -1;
end;
function TTestBE.QueryInterface(constref IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj)
then Result := 0
end;
Var
Test : TTest;
A : ITest;
begin
Test := TTest.Create;
Test.BE := TTestBE.Create;
// Works ok in Lazarus and Delphi
Test.BE.GetInterface (ITest, A);
// Works ok in Lazarus. Delphi will not compile this line
A := Test.BE As ITest;
// Both Delphi and Lazarus return nil ptr
Test.GetInterface(ITest, A);
// Works in Lazarus
Test.QueryInterface (ITest, A);
// Lazarus throws typecast error.
// Works fine in delphi because delphi calls QueryInterface while Lazarus does not
A := Test As ITest;
end.
|
