Найдено на: http://www.i-rs.ru/article/articleprint/472/-1/51/

Первые шаги в автоматизации OpenOffice.Calc и OpenOffice.Writer под Delphi

Автор: Васильков Ю. B.

Дата публикации: 11.05.2007 22:41

Листинг 1

function TOpenOffice.Connect: boolean;
begin
   if VarIsEmpty(OO) then
      OO := CreateOleObject('com.sun.star.ServiceManager');
   Result := not (VarIsEmpty(OO) or VarIsNull(OO));
end;

Листинг 2
procedure TOpenOffice.Disconnect;
begin
   OO := Unassigned;
end;

Листинг 3
function TOpenOffice.CreateDocument: boolean;
var
   Desktop: Variant;
begin
   Desktop := OO.createInstance('com.sun.star.frame.Desktop');
   Document := Desktop.LoadComponentFromURL(
                  'private:factory/swriter', '_blank', 0,
                  VarArrayCreate([0, -1], varVariant));
   Result := not (VarIsEmpty(Document) or VarIsNull(Document));
end;

Листинг 4
function TOpenOffice.OpenDocument(const FileName:string): boolean;
var
   Desktop: Variant;
   VariantArray: Variant;
begin
   Desktop := OO.CreateInstance('com.sun.star.frame.Desktop');
   VariantArray := VarArrayCreate([0, 0], varVariant);
   VariantArray[0] := MakePropertyValue('FilterName', 'MS Word 97');
   Document := Desktop.LoadComponentFromURL(FileName, '_blank', 0,VariantArray);
   Result := not (VarIsEmpty(Document) or VarIsNull(Document));
end;

Листинг 5
function TOpenOffice.MakePropertyValue(PropertyName, PropertyValue:string):variant;
var
	Structure: variant;
begin
    Structure := OO.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
    Structure.Name := PropertyName;
    Structure.Value := PropertyValue;
    Result := Structure;
end;

Листинг 6

procedure TOpenOffice.SaveDocument(const FileName:String);
var
   Desktop: Variant;
   VariantArray: Variant;
begin
   Desktop := OO.createInstance('com.sun.star.frame.Desktop');
   VariantArray := VarArrayCreate([0, 0], varVariant);
   VariantArray[0] := MakePropertyValue('FilterName', 'MS Word 97');
   Document.StoreToURL(FileName, VariantArray);
end;

Листинг 7
procedure TOpenOffice.SaveAs(FileName: String);
const
   Bounds:array[1..2] of integer = (0,1);
var
   VariantArray: Variant;
begin
   VariantArray := VarArrayCreate([0,1], varVariant);
   VariantArray[0] :=  MakePropertyValue('FilterName', 'MS Excel 97');
   VariantArray[1] :=  MakePropertyValue('Overwrite', True);
   Document.storeToURL('file:///'+FileName, VariantArray);
end;

Листинг 8

procedure TOpenOffice.CloseDocument();
begin

 Document.Close(True);
 Document:=Unassigned;
end;

Листинг 9
procedure TOpenOffice.Print(iNumCopies:integer);
const Bounds:array[1..2] of integer = (0,0);
var

    VariantArray: Variant;

begin
    if ( iNumCopies < 1 ) or ( iNumCopies > 512 ) then
       iNumCopies := 1;
    VariantArray := VarArrayCreate(Bounds, varVariant);
    VariantArray[0]:= MakePropertyValue('CopyCount',iNumCopies);
    Document.print(VariantArray);
end;

Листинг 10
procedure TOpenOffice.InsertTextWriter(const Text: String);
var
   TextPointer: Variant;
   CursorPointer: Variant;
begin
   TextPointer := Document.GetText;
   CursorPointer := TextPointer.CreateTextCursor;

   TextPointer.InsertString(CursorPointer, Text, false);
   TextPointer.InsertControlCharacter(CursorPointer, 0, false);
end;

Листинг 11
procedure TOpenOffice.InsertTextByNameWriter(const Text: String, BookmarkName: String );
 var
   TextPointer: Variant;
   CursorPointer: Variant;
   BookmarksSupplier: Variant;
   Bookmark: Variant;
   Flag: boolean;
begin
   Flag:=True;
   TextPointer := Document.GetText;
   CursorPointer := TextPointer.CreateTextCursor;
   BookmarksSupplier:=Document.getBookmarks;
   try
     Bookmark:=BookmarksSupplier.getByName(BookmarkName).getAnchor;
   except
     ShowMessage('Такой метки нет');
     Flag:=False;
   end;
   if(Flag) then Bookmark.setString(Text);
end;

Листинг 12
procedure TOpenOffice.GetSheet(const Index :Word);
begin
   Sheet := Sheets.getByIndex(Index);
end;

Листинг 13
procedure TOpenOffice.InsertTextByCoord(const Text: String; col:integer; row:integer);
begin
   Cell := Sheet.getCellByPosition(col, row);
   Сell.setString(Text);
end;

Листинг 14
procedure TOpenOffice.InsertTextByName(const Text: String; Name: String);
var
   i:boolean;
   j:integer;
   Perem :longint;
begin
   Perem:=0;
   Perem:=Sheets.getCount;
   j:=0;
   repeat
      i:=True;
      Sheet := Sheets.getByIndex(j);
      try
         Sheet.getCellRangeByName(Name);
      except
         j:=j+1;
         i:=False;
         Perem:=Perem-1;
      end;
   until (i or (Perem=1));
   if(Perem=1) then ShowMessage('Нет такой метки')
   else
      begin
         Cell:=Sheet.getCellRangeByName(Name);
         Cell.setString(Text);
       end;
end;

Листинг 15
procedure TOpenOffice.InsertTableByName(Text1:String; Text2:String;   Text3:String; Text4:String; Name:String);
const Bounds:array[1..4] of integer = (1,2,1,2);
var
   VariantArray:Variant;
   i:boolean;
   j:integer;
   Range: Variant;
   Perem :longint;
begin
   VariantArray := VarArrayCreate(Bounds, varVariant);
   Perem:=0;
   Perem:=Sheets.getCount;
   VariantArray[1,1]:=Text1;
   VariantArray[1,2]:=Text2;
   VariantArray[2,1]:=Text3;
   VariantArray[2,2]:=Text4;
   j:=0;
   repeat
      i:=True;
      Sheet := Sheets.getByIndex(j);
      try
         Sheet.getCellRangeByName(Name);
      except
         j:=j+1;
         i:=False;
         Perem:=Perem-1;
      end;

   until (i or (Perem=1));
   if(Perem=1) then ShowMessage('Нет такой метки')
   else
      begin
          Range:=Sheet.getCellRangeByName(Name);

          Range.setDataArray(VariantArray);
       end;
end;

VariantArray := VarArrayCreate(Bounds, varVariant);
VariantArray[1,1]:=Text1;
VariantArray[1,2]:=Text2;
VariantArray[2,1]:=Text3;
VariantArray[2,2]:=Text4;

Листинг 16
procedure TOpenOffice.RangeFormat(Name:String; FontName:String;
       FontSize, FontType, FontColor, BackColor:longint);
var
 font: TFont;
 Range: Variant;
begin
   Range:=GetRange(Name);
   if FontName <> '' then Range.charFontName:=FontName;
   if FontSize <> 0 then Range.charHeight:=FontSize;
   if FontType <> -1 then
      begin
         if(FontType and $04)=4 then
            Range.charWeight:=fsBold else
            Range.charWeight:=0;
         if(FontType and $02)=2 then
            Range.charPosture:=fsItalic else
            Range.charPosture:=0;
         if(FontType and $01)=1 then
            Range.charUnderline:=fsUnderline else
            Range.charUnderline:=0;
      end;
      if FontColor <> -1 then
         Range.charColor:=FontColor;
      if BackColor <> -1 then
         Range.cellBackColor:=BackColor;
end;

Листинг 17
function TOpenOffice.GetRange(Name: String): Variant;
var
   i: integer;
   Sheet: Variant;
begin
   for i := 0 to Sheets.getCount - 1 do
   try
        Sheet  := Sheets.getByIndex( i );
        Result := Sheet.getCellRangeByName( Name );
        if not ( VarIsEmpty(Result) or VarIsNull(Result)) then
        Exit;
   except
     Result := Null;
   end;
end;