blob: 663614c1df2784ede4ed2ed8b7b1863ebf47c03c (
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
|
program vclcomobject;
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
type
TDummyVCLComObject = class(TInterfacedObject, IVCLComObject)
public
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; override;
procedure FreeOnRelease;
end;
var
c: TComponent;
v: IVCLComObject;
procedure DoCreateVCLComObject(Component: TComponent);
begin
Component.VCLComObject := Pointer(V);
end;
{ TDummyVCLComObject }
procedure TDummyVCLComObject.FreeOnRelease;
begin
end;
function TDummyVCLComObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TDummyVCLComObject.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
end;
function TDummyVCLComObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
end;
function TDummyVCLComObject.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TDummyVCLComObject.SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult;
begin
Result := E_UNEXPECTED;
end;
begin
v := TDummyVCLComObject.Create;
CreateVCLComObjectProc := @DoCreateVCLComObject;
c := TComponent.Create(nil);
if c.ComObject = nil then
halt(1);
c.Free;
v := nil;
end.
|
