如何使用 Delphi 在 Openoffice 文档的 Header/Footer/Table 中搜索文本标签并替换为图像

Question

我有打开的 office 模板文档，我需要在其中搜索 [CHART=100] 之类的标签，并将其替换为驻留在 PC 上某个文件夹中的图像文件。

我正在使用上一个问题中提到的方法。 .

Procedure ReplaceTextTagsWithImage(sFileTobeReplaced,ImageFile:string);
  var
    ServiceManager: Variant;
    Desktop: Variant;
    Document: Variant;
    NoParams : Variant;
    FileReplace: Variant;
    FileSearch : Variant;
    Txt : Variant;
    TextCursor : Variant;
    FileParams: Variant;
    Graphic : Variant;
    FileProperty,Imageproperty: Variant;
    afileurl,gurl : string;
    xinterface,xTextRange,curTextView : variant;
    ppoint : variant;
    SearchDescriptor,found : Variant;
    IdNumber : Integer;
    sNumber : string;
    Bitmaps : Variant;

    function CreateProperty(const AName: AnsiString; const AValue: Variant): Variant;
    begin
      Result := ServiceManager.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
      Result.Name := AName;
      Result.Value := AValue;
    end;

  begin
    Try
      ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
      Desktop := ServiceManager.createInstance('com.sun.star.frame.Desktop');
      FileParams := VarArrayCreate([0, 0], varVariant);
      FileParams[0] := CreateProperty('Hidden',True); {hide Document}
      afileurl := 'file:///'+sFileTobeReplaced;
      Document := Desktop.loadComponentFromURL(afileurl, '_blank', 0, FileParams);
      Txt := Document.getText;
      TextCursor := Txt.createTextCursor;
      SearchDescriptor := Document.createSearchDescriptor;

      SearchDescriptor.setSearchString('[CHART=[0-9].*]');
      SearchDescriptor.SearchRegularExpression := True;
      Found := Document.findFirst(SearchDescriptor);
      Bitmaps := Document.createInstance('com.sun.star.drawing.BitmapTable');
      While Not (VarIsNull(Found) or VarIsEmpty(Found) or VarIsType(Found,varUnknown)) do
      begin
         sNumber := String(Found.getString);
         sNumber := copy(String(Found.getString), Length('<CHART=')+1 );
         sNumber := copy(Trim(sNumber),1,length(sNumber)-1);
         Found.setString('');
         Graphic := Document.createInstance('com.sun.star.text.GraphicObject');
         gurl := 'file:///'+ImageFile;
         if not Bitmaps.hasbyname(sNumber+'_Image') then
            Bitmaps.insertByName(sNumber+'_Image', gurl);
         Graphic.GraphicURL := Bitmaps.getByName(sNumber+'_Image');
         Graphic.AnchorType := 1; {com.sun.star.text.TextContentAnchorType.AS_CHARACTER;}
         Graphic.Width := 6000;
         Graphic.Height := 8000;
         TextCursor.gotoRange(Found, False);
         Txt.insertTextContent(TextCursor, Graphic, False);
         Found := Document.findNext(Found.getEnd, SearchDescriptor);
      end;
      FileParams[0] := CreateProperty('Overwrite',True);
      Document.storeAsURL(afileurl, FileParams);
      Document.Close(True);
      Try
        Desktop.Terminate;
      except
      end;
    Finally
      Document := Unassigned;
      Desktop := Unassigned;
      ServiceManager := Unassigned;
    end;
  end;


  procedure TForm6.Button3Click(Sender: TObject);
  var
    sFileToBeReplaced : String;
    sImageFile : String;
  begin
    sFileToBeReplaced := edOOFile.Text;
    sImageFile := edImageFile.Text;
    Try
      ReplaceTextTagsWithImage(sFileToBeReplaced,sImageFile);
      ShowMessage('Success');
    Except
      on E: Exception do
      ShowMessage(E.Message);

    End;
  end;

当标签文本不在 header/footer/table 中时，此代码工作正常，但是如果我在 header/footer/table 中定义标签，我会在

处收到错误 "com.sun.star.uno.RuntimeException:"

TextCursor.gotoRange(Found, False);

我不确定如何在搜索和替换中引用范围。

请建议如何实现它。

Answer 1

页眉、表格等都有自己的文本对象，所以主文档的文本对象将不起作用。相反，从 Found.

获取文本对象和光标

此外，从正则表达式中删除 . 以匹配多个数字而不是任何数字的倍数。括号必须是文字。

这是有效的基本代码。

Sub ReplaceTextTagsWithImage
    Document = ThisComponent
    Bitmaps = Document.createInstance("com.sun.star.drawing.BitmapTable")
    ImageFile = "C:/google_wht.gif"
    SearchDescriptor = Document.createSearchDescriptor()
    SearchDescriptor.setSearchString("\[CHART=[0-9]*\]")
    SearchDescriptor.SearchRegularExpression = True
    Found = Document.findFirst(SearchDescriptor)
    Do While Not IsNull(Found)
        TextCursor = Found.getText().createTextCursor()
        TextCursor.gotoRange(Found, False)
        Graphic = Document.createInstance("com.sun.star.text.GraphicObject")
        gurl = "file:///" & ImageFile
        gname = sNumber & "_Image"
        if Not Bitmaps.hasbyname(gname) Then
            Bitmaps.insertByName(gname, gurl)
        End If
        Graphic.GraphicURL = Bitmaps.getByName(gname)
        Graphic.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
        Graphic.Width = 6000
        Graphic.Height = 8000
        TextCursor.getText().insertTextContent(TextCursor, Graphic, False)
        Found = ThisComponent.findNext( Found.End, SearchDescriptor)
    Loop
End Sub

如何使用 Delphi 在 Openoffice 文档的 Header/Footer/Table 中搜索文本标签并替换为图像

How to Search text tags and replace with Image in Header/Footer/Table of Openoffice Document using Delphi

delphi

openoffice-writer