mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 03:50:23 +02:00
93 lines
2.7 KiB
ObjectPascal
93 lines
2.7 KiB
ObjectPascal
{ %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.
|