Главная arrow В помощь студентам arrow Статьи по программированию в Delphi arrow Процедуры и функции для работы с OpenOffice  
03.12.2024 г.
Процедуры и функции для работы с OpenOffice Печать E-mail
Автор Administrator   
11.03.2009 г.

Автор: Владимир Ермарков, Королевство Delphi

Все в мире развивается по спирали. Раньше программисты разрабатывали механизмы взаимодействия между Delphi и MSExcel, теперь они методом проб и ошибок создают приложения для создания документов в OpenOffice. Надеюсь, что эта статья сэкономит время и усилия для решения более важных проблем, чем открытие шаблона и поиск нужной ячейки.

Автор ни в коем случае не возлагает на себя лавры разработчика-первооткрывателя. Очень многое из данной статьи лежит в интернете на разных сайтах. Например - http://delphi.vline.ru/articles/openoffice/index.html и http://www.delphimaster.ru/articles/openoffice/index.html и др.

Другие процедуры и функции были созданы прямо в процессе работы над заданием. Все было проверено на работоспособность.

Итак, начнем.

Для удобства работы, вынесем базовые функции и процедуры в новый класс

type TopofCalc = class(TObject)

при работе с таблицами, информация о типе документа может принимать следующие состояния:

type TTipooCalc = (ttcError, ttcNone, ttcExcel, ttcOpenOffice);

данные функции определяет тип приложения

function  TopofCalc.GetIsExcel: boolean;
begin
  result:= (Tipoo=ttcExcel);
end;
 
function  TopofCalc.GetIsOpenOffice: boolean;
begin
  result:= (Tipoo=ttcOpenOffice);
end;

и произведена ли его загрузка

function TopofCalc.GetProgLoaded: boolean;
begin
  result:= not (VarIsEmpty(Programa) or VarIsNull(Programa));
end;
 
function TopofCalc.GetDocLoaded: boolean;
begin
  result:= not (VarIsEmpty(Document) or VarIsNull(Document));
end;

запуск приложения…

procedure TopofCalc.LoadProg;
begin
  if ProgLoaded then CloseProg;
  if ((UpperCase(ExtractFileExt(FileName))='.XLS') or
     (UpperCase(ExtractFileExt(FileName))='.XLT')) then begin
    //Excel...
    Programa:= CreateOleObject('Excel.Application');
    Programa.Application.EnableEvents:=false;
    Programa.displayAlerts:=false;
    if ProgLoaded then Tipoo:= ttcExcel;
  end;
  // Another filetype? Let's go with OpenOffice...
  if ((UpperCase(ExtractFileExt(FileName))='.ODS') or
     (UpperCase(ExtractFileExt(FileName))='.OTS')) then begin
    //OpenOffice.calc...
    Programa:= CreateOleObject('com.sun.star.ServiceManager');
    if ProgLoaded then Tipoo:= ttcOpenOffice;
  end;
  //Still no program loaded?
  if not ProgLoaded then begin
    Tipoo:= ttcError;
    raise Exception.create('TopofCalc.create failed, may be no Office is installed?');
  end;
end;

проведя все необходимые проверки, мы можем создать электронную таблицу

procedure TopofCalc.NewDoc;
var ooParams: variant;
begin
  if not ProgLoaded
     then raise exception.create('No program loaded for the new document.');
  if DocLoaded then CloseDoc;
  DeskTop:= Unassigned;
  if IsExcel then begin
    Programa.WorkBooks.Add();
    Programa.Visible:= Visible;
    Document:= Programa.ActiveWorkBook;
    ActiveSheet:= Document.ActiveSheet;
  end;
  if IsOpenOffice then begin
    Desktop:=  Programa.CreateInstance('com.sun.star.frame.Desktop');
    ooParams:=    VarArrayCreate([0, 0], varVariant);
    ooParams[0]:= ooCreateValue('Hidden', not Visible);
    Document:= Desktop.LoadComponentFromURL('private:factory/scalc', '_blank',
                                             0, ooParams);
    ActivateSheetByIndex(1);
  end;
end;

а теперь закрыть таблицу

procedure TopofCalc.CloseDoc;
begin
  if DocLoaded then begin
    try
      if IsOpenOffice then Document.Dispose;
      if IsExcel      then Document.close;
    finally
      //Clean up both "pointer"...
      Document:= Null;
      ActiveSheet:= Null;
    end;
  end;
end;

и само приложение

procedure TopofCalc.CloseProg;
begin
  if DocLoaded then CloseDoc;
  if ProgLoaded then begin
    try
      if IsExcel then Programa.Quit;
      Programa:= Unassigned;
    finally end;
  end;
  Tipoo:= ttcNone;
end;

вынесем последовательности команд создания таблицы в отдельную процедуру конструктора

constructor TopofCalc.CreateTable(MyTipoo: TTipooCalc; MakeVisible: boolean);
var
  i: integer;
  IsFirstTry: boolean;
begin
  //Close all opened things first...
  if DocLoaded  then CloseDoc;
  if ProgLoaded then CloseProg;
  IsFirstTry:= true;
  for i:= 1 to 2 do begin
    //Try to open OpenOffice...
    if (MyTipoo = ttcOpenOffice) or (MyTipoo = ttcNone)then begin
      Programa:= CreateOleObject('com.sun.star.ServiceManager');
      if ProgLoaded then begin
        Tipoo:= ttcOpenOffice;
        break;
      end else begin
        if IsFirstTry then begin
          //Try Excel as my second choice
          MyTipoo:= ttcExcel;
          IsFirstTry:= false;
        end else begin
          //Both failed!
          break;
        end;
      end;
    end;
    //Try to open Excel...
    if (MyTipoo = ttcExcel) or (MyTipoo = ttcNone) then begin
      Programa:= CreateOleObject('Excel.Application');
      if ProgLoaded then begin
        Tipoo:= ttcExcel;
        break;
      end else begin
        if IsFirstTry then begin
          //Try OpenOffice as my second choice
          MyTipoo:= ttcOpenOffice;
          IsFirstTry:= false;
        end else begin
          //Both failed!
          break;
        end;
      end;
    end;
  end;
  //Was it able to open any of them?
  if Tipoo = ttcNone then begin
    Tipoo:= ttcError;
    raise exception.create('TopofCalc.create failed, may be no OpenOffice is installed?');
  end;
  //Add a blank document...
  fVisible:= MakeVisible;
  NewDoc;
end;

это - создание таблицы "с нуля". откроем существующую

procedure TopofCalc.LoadDoc;
var ooParams: variant;
begin
  if FileName='' then exit;
  if not ProgLoaded then LoadProg;
  if DocLoaded then CloseDoc;
  DeskTop:= Unassigned;
  if IsExcel then begin
    Document:=Programa.WorkBooks.Add(FileName);
    Document.visible:=visible;
    Document:= Programa.ActiveWorkBook;
    ActiveSheet:= Document.ActiveSheet;
  end;
  if IsOpenOffice then begin
    Desktop:=  Programa.CreateInstance('com.sun.star.frame.Desktop');
    ooParams:=    VarArrayCreate([0, 0], varVariant);
    ooParams[0]:= ooCreateValue('Hidden', not Visible);
    Document:= Desktop.LoadComponentFromURL(FileNameToURL(FileName), '_blank', 0, ooParams);
      ActivateSheetByIndex(1);
  end;
  if Tipoo=ttcNone then
    raise exception.create('File "'+FileName+'" is not loaded. Are you install OpenOffice?');
end;

опишем еще один конструктор для открытия существующей таблицы

constructor TopofCalc.OpenTable(Name: string; MakeVisible: boolean);
begin
  //Store values...
  FileName:= Name;
  fVisible:=  MakeVisible;
  //Open program and document...
  LoadProg;
  LoadDoc;
end;

кроме того, опишем уничтожение объекта

destructor TopofCalc.Destroy;
begin
  CloseDoc;
  CloseProg;
  inherited;
end;

по аналогии, опишем сохранение

function TopofCalc.SaveDoc: boolean;
begin
  result:= false;
  if DocLoaded then begin
    if IsExcel then begin
      Document.Save;
      result:= true;
    end;
    if IsOpenOffice then begin
      Document.Store;
      result:= true;
    end;
  end;
end;

печать

function TopofCalc.PrintDoc: boolean;
var ooParams: variant;
begin
  result:= false;
  if DocLoaded then begin
    if IsExcel then begin
      Document.PrintOut;
      result:= true;
    end;
    if IsOpenOffice then begin
      //NOTE: OpenOffice will print all sheets with Printable areas, but if no
      //printable areas are defined in the doc, it will print all entire sheets.
      //Optional parameters (wait until fully sent to printer)...
      ooParams:=  VarArrayCreate([0, 0], varVariant);
      ooParams[0]:= ooCreateValue('Wait', true);
      Document.Print(ooParams);
      result:= true;
    end;
  end;
end;

и режим предварительного просмотра

procedure TopofCalc.ShowPrintPreview;
begin
  if DocLoaded then begin
    Visible:= true;
    if IsExcel then
      Document.PrintOut(,,,true);
    if IsOpenOffice then
      ooDispatch('.uno:PrintPreview', Unassigned);
  end;
end;

нам также пригодится скрытие/отображение на экране

procedure TopofCalc.SetVisible(v: boolean);
begin
  if DocLoaded and (v<>fVisible) then begin
    if IsExcel then
      Programa.Visible:= v;
    if IsOpenOffice then
      Document.getCurrentController.getFrame.getContainerWindow.setVisible(v);
    fVisible:= v;
  end;
end;

теперь, мы можем получить информацию о таблице.
Начнем с количества листов

function TopofCalc.GetCountSheets: integer;
begin
  result:= 0;
  if DocLoaded then begin
    if IsExcel      then result:= Document.Sheets.count;
    if IsOpenOffice then result:= Document.getSheets.GetCount;
  end;
end;

и сделаем один из листов активным.

function TopofCalc.ActivateSheetByIndex(nIndex: integer): boolean;
begin
  result:= false;
  if DocLoaded then begin
    if IsExcel then begin
      Document.Sheets[nIndex].activate;
      ActiveSheet:= Document.ActiveSheet;
      result:= true;
    end;
//Index is 1 based in Excel, but OpenOffice uses it 0-based
    if IsOpenOffice then begin
      ActiveSheet:= Document.getSheets.getByIndex(nIndex-1);
      result:= true;
    end;
    sleep(100); //Asyncronus, so better give it time to make the change
  end;
end;

активным лист можно сделать не только по его индексу, но и по названию

function TopofCalc.ActivateSheetByName(SheetName: string; CaseSensitive: boolean): boolean;
var
  OldActiveSheet: variant;
  i: integer;
begin
  result:= false;
  if DocLoaded then begin
    if CaseSensitive then begin
      //Find the EXACT name...
      if IsExcel then begin
        Document.Sheets[SheetName].Select;
        ActiveSheet:= Document.ActiveSheet;
        result:= true;
      end;
      if IsOpenOffice then begin
        ActiveSheet:= Document.getSheets.getByName(SheetName);
        result:= true;
      end;
    end else begin
      //Find the Sheet regardless of the case...
      OldActiveSheet:= ActiveSheet;
      for i:= 1 to GetCountSheets do begin
        ActivateSheetByIndex(i);
        if UpperCase(ActiveSheetName)=UpperCase(SheetName) then begin
          result:= true;
          Exit;
        end;
      end;
      //If not found, let the old active sheet active...
      ActiveSheet:= OldActiveSheet;
    end;
  end;
end;

getByName(string) имеет свойства для чтения и записи

function TopofCalc.GetActiveSheetName: string;
begin
  if DocLoaded then begin
    if IsExcel then
      result:= ActiveSheet.Name;
    if IsOpenOffice then
      result:= ActiveSheet.GetName;
  end;
end;
 
procedure TopofCalc.SetActiveSheetName(NewName: string);
var ooParams:variant;
begin
  if DocLoaded then begin
    if IsExcel then
      Programa.ActiveSheet.Name:= NewName;
    if IsOpenOffice then begin
      ActiveSheet.setName(NewName);
      //This code always changes the name of "visible" sheet, not active one!
      ooParams:= VarArrayCreate([0, 0], varVariant);
      ooParams[0]:= ooCreateValue('Name', NewName);
      ooDispatch('.uno:RenameTable', ooParams);
    end;
  end;
end;

пригодится проверка на защиту листа от записи

function TopofCalc.IsActiveSheetProtected: boolean;
begin
  result:= false;
  if DocLoaded then begin
    if IsExcel then
      result:= ActiveSheet.ProtectContents;
    if IsOpenOffice then
      result:= ActiveSheet.IsProtected;
  end;
end;

добваление листа

procedure TopofCalc.AddNewSheet(NewName: string);
var
  ooSheets: variant;
begin
  if DocLoaded then begin
    if IsExcel then begin
      Document.WorkSheets.Add;
      Document.ActiveSheet.Name:= NewName;
      //Active sheet has move to this new one, so I need to update the var
      ActiveSheet:= Document.ActiveSheet;
    end;
    if IsOpenOffice then begin
      ooSheets:= Document.getSheets;
      ooSheets.insertNewByName(NewName, 1);
      //Redefine active sheet to this new one
      ActiveSheet:= ooSheets.getByName(NewName);
    end;
  end;
end;

перейдем от листов к ячейкам
получить значение ячейки

//OpenOffice start at cell (0,0) while Excel at (1,1)
function TopofCalc.GetCellText(row, col: integer): string;
begin
  if DocLoaded then begin
    if IsExcel then      result:= ActiveSheet.Cells[row, col].Formula; //.Text;
    if IsOpenOffice then result:= ActiveSheet.getCellByPosition(col-1, row-1).getFormula;
  end;
end;

установить значение

procedure  TopofCalc.SetCellText(row, col: integer; Txt: string);
begin
  if DocLoaded then begin
    if IsExcel then      ActiveSheet.Cells[row, col].Formula:= Txt;
    if IsOpenOffice then ActiveSheet.getCellByPosition(col-1, row-1).setFormula(Txt);
  end;
end;

то же самое, но по имени ячейки.

Обязательно указание номера листа

function TopofCalc.GetCellTextByName(Range: string): string;
var OldActiveSheet: variant;
begin
  if DocLoaded then begin
    if IsExcel then begin
      result:=  Programa.Range[Range].Text; //Set 'Formula' but Get 'Text';
    end;
    if IsOpenOffice then begin
      OldActiveSheet:= ActiveSheet;
      //If range is in the form 'NewSheet!A1' then first change sheet to 'NewSheet'
      if pos('!', Range) > 0 then begin
        //Activate the proper sheet...
        if not ActivateSheetByName(Copy(Range, 1, pos('!', Range)-1), false) then
          raise exception.create('Sheet "'+Copy(Range, 1, pos('!', Range)-1)+
                                 '" not present in the document.');
        Range:= Copy(Range, pos('!', Range)+1, 999);
      end;
      result:= ActiveSheet.getCellRangeByName(Range).getCellByPosition(0,0).getFormula;
      ActiveSheet:= OldActiveSheet;
    end;
  end;
end;
 
procedure  TopofCalc.SetCellTextByName(Range: string; Txt: string);
var OldActiveSheet: variant;
begin
  if DocLoaded then begin
    if IsExcel then begin
      Programa.Range[Range].formula:= Txt;
    end;
    if IsOpenOffice then begin
      OldActiveSheet:= ActiveSheet;
      //If range is in the form 'NewSheet!A1' then first change sheet to 'NewSheet'
      if pos('!', Range) > 0 then begin
        //Activate the proper sheet...
        if not ActivateSheetByName(Copy(Range, 1, pos('!', Range)-1), false) then
          raise exception.create('Sheet "'+Copy(Range, 1, pos('!', Range)-1)+
                                 '" not present in the document.');
        Range:= Copy(Range, pos('!', Range)+1, 999);
      end;
      ActiveSheet.getCellRangeByName(Range).getCellByPosition(0,0).SetFormula(Txt);
      ActiveSheet:= OldActiveSheet;
    end;
  end;
end;

а так же - размера шрифта. Можно установить его в шаблоне, а можно прямо в ходе работы программы.

procedure TopofCalc.FontSize(row,col:integer;oosize:integer);
begin
  if DocLoaded then begin
    if IsExcel then begin
      Programa.ActiveSheet.Cells[row,col].Font.Size:=oosize;
    end;
    if IsOpenOffice then begin
      ActiveSheet.getCellByPosition(col-1, row-1).getText.createTextCursor.CharHeight:= oosize;
    end;
  end;
end;

сделать шрифт жирным

procedure TopofCalc.Bold(row,col: integer);
const ooBold: integer = 150; //150 = com.sun.star.awt.FontWeight.BOLD
begin
  if DocLoaded then begin
    if IsExcel then begin
      Programa.ActiveSheet.Cells[row,col].Font.Bold;
    end;
    if IsOpenOffice then begin
      ActiveSheet.getCellByPosition(col-1, row-1).getText.createTextCursor.CharWeight:= ooBold;
    end;
  end;
end;

изменить ширину столбца

procedure TopofCalc.ColumnWidth(col,  width: integer); //Width in 1/100 of mm.
begin
  if DocLoaded then begin
    if IsExcel then begin
      //Excel use the width of '0' as the unit, we do an aproximation: Width '0' = 2 mm.
      Programa.ActiveSheet.Cells[col, 1].ColumnWidth:= width/100/3;
    end;
    if IsOpenOffice then begin
      ActiveSheet.getCellByPosition(col-1, 0).getColumns.getByIndex(0).Width:= width;
    end;
  end;
end;

в заключение, предлагаю функции, предназначенные именно для OpenOffice

преобразование имени

//Change 'C:\File.txt' into 'file:///c:/File.txt' (for OpenOffice OpenURL)
function TopofCalc.FileNameToURL(FileName: string): string;
begin
  result:= '';
  if LowerCase(copy(FileName,1,8))<>'file:///' then
    result:= 'file:///';
  result:= result + StringReplace(FileName, '\', '/', [rfReplaceAll, rfIgnoreCase]);
end;
 

создание объекта

function TopofCalc.ooCreateValue(ooName: string; ooData: variant): variant;
var
  ooReflection: variant;
begin
  if IsOpenOffice then begin
    ooReflection:= Programa.createInstance('com.sun.star.reflection.CoreReflection');
    ooReflection.forName('com.sun.star.beans.PropertyValue').createObject(result);
    result.Name := ooName;
    result.Value:= ooData;
  end else begin
    raise exception.create('ooValue imposible to create, load OpenOffice first!');
  end;
end;

запуск диспатчера

procedure TopofCalc.ooDispatch(ooCommand: string; ooParams: variant);
var
  ooDispatcher, ooFrame: variant;
begin
  if DocLoaded and IsOpenOffice then begin
    if (VarIsEmpty(ooParams) or VarIsNull(ooParams)) then
      ooParams:= VarArrayCreate([0, -1], varVariant);
    ooFrame:= Document.getCurrentController.getFrame;
    ooDispatcher:= Programa.createInstance('com.sun.star.frame.DispatchHelper');
    ooDispatcher.executeDispatch(ooFrame, ooCommand, '', 0, ooParams);
  end else begin
    raise exception.create('Dispatch imposible, load a OpenOffice doc first!');
  end;
end;
 
end.
 
« Пред.   След. »

Ivanovo State University of Chemical Technology has entered into an academic partnership with Visual Paradigm to better facilitate the teaching of software design & modeling through the use of Visual Paradigm.
Enterprise Architect
Sparx Systems Enterprise Arctitect provides Ivanovo State University of Chemical Technology with Enterprise Architect, Eclipse Integration, Visual Studio Integration, SysML Technology, Zachman Framework and much more for use in educational purposes, offered by the Enterprise Architect Academic Site License.