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
89
90
91
92
|
{ %TARGET=win32,win64 }
{ %NOTE=This test requires an installed OpenOffice }
{ %INTERACTIVE }
{ This test does create Open Office crashes.
So we restrict it to interactive mode }
program ttt;
{$ifdef fpc}
{$mode delphi}
{$endif fpc}
uses
Windows, SysUtils, Classes, ComObj, ActiveX, Variants;
var StarOffice : Variant;
Document : Variant;
function TSampleCode_Connect(OleName : string) : boolean;
begin
if VarIsEmpty(StarOffice) then
begin
try
Writeln('Trying to connect to ',OleName);
StarOffice := CreateOleObject(OleName);
except
on e : exception do
begin
StarOffice:=Unassigned;
Writeln('Connection to ',OleName,' failed: ',e.message);
end;
end;
end;
Result := not (VarIsEmpty(StarOffice) or VarIsNull(StarOffice));
end;
function TSampleCode_CreateDocument(bReadOnly : boolean) : boolean;
var
StarDesktop : Variant;
LoadParams : Variant;
CoreReflection : Variant;
PropertyValue : Variant;
AutoObject : Variant;
TextObject : Variant;
Cursor : Variant;
begin
StarDesktop := StarOffice.createInstance('com.sun.star.frame.Desktop');
if (bReadOnly) then begin
LoadParams := VarArrayCreate([0, 0], varVariant);
CoreReflection := StarOffice.createInstance('com.sun.star.reflection.CoreReflection');
CoreReflection.forName('com.sun.star.beans.PropertyValue').
createObject(PropertyValue); // CoreReflection().forName().createObject() bring to "Illegal qualifier"
AutoObject := CoreReflection.forName('com.sun.star.beans.PropertyValue');
AutoObject.createObject(PropertyValue);
PropertyValue.Name := 'ReadOnly'; // "Arg cant be assigned" and
PropertyValue.Value := true; // "Incompatimle types: const string, untyped expected"
LoadParams[0] := PropertyValue;
end
else
LoadParams := VarArrayCreate([0, -1], varVariant);
Document := StarDesktop.LoadComponentFromURL( 'private:factory/swriter', '_blank', 0, LoadParams);
if not bReadOnly then begin
TextObject := Document.Text;
Cursor := TextObject.createTextCursor;
TextObject.insertString(Cursor,'Output of FPC Test tdispvar1.pp',False);
// works with D7, but not FPC
end;
Result := not (VarIsEmpty(Document) or VarIsNull(Document));
end;
begin
CoInitialize(nil);
if TSampleCode_Connect('com.sun.star.ServiceManager') then
begin
if TSampleCode_CreateDocument(false) then
Document.Close(false);
end;
StarOffice:=Unassigned;
if TSampleCode_Connect('com.sun.star.ServiceManager.NonExisting.Variant.Just.To.Test') then
begin
if TSampleCode_CreateDocument(false) then
Document.Close(false);
end;
CoUnInitialize;
end.
|
