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

Question

I have open office template documents where i need to search for tags like [CHART=100] and replace it with a Image file reside in some folder at PC.

I am using approach mentioned in my previous question. How to insert image in OpenOffice Document using Delphi.

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;

This code works fine when Tag text is not in header/footer/table, however if i define tag in header/footer/table i get error "com.sun.star.uno.RuntimeException:" at

TextCursor.gotoRange(Found, False); 

I am not sure how to refer ranges in search and replace.

Please suggest how to achieve it.

Answer 1

Headers, tables and so on have their own text object, so the text object of the main document will not work. Instead, get the text object and cursor from Found.

Also, remove . from the regular expression to match multiple digits instead of multiple of anything. And the brackets must be literal.

Here is working Basic code.

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