Delphi - сбориник статей


Процедуры и функции для работы с OpenOffice


Владимир Ермаков, Королевство Дельфи

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

Автор ни в коем случае не возлагает на себя лавры разработчика-первооткрывателя. Очень многое из данной статьи лежит в интернете на разных сайтах. Например — и др.

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

Для удобства работы, вынесем базовые функции и процедуры в новый класс 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.




Начало    



Книжный магазин