LibreOffice Writer API - Cursors and text selection / replacement from VB6-CodePudding

I have been attempting to replace Office OLE in a vb6 application with LibreOffice.

I have had some success, however, I am falling short trying to search for text, then create a cursor based on the text that was found, then insert an image at that cursors point in the document.

I have been able to piece together working code that will allow me to search for text, replace text and insert an image, however, I cannot seem to figure out how to create a cursor that will allow me to insert an image at the pace where the text is that I have found . In the provided example, the [PICTUREPLACEHOLDER] text in the document.

Has anyone ever done this before and do they have any suggestions how I can create a cursor that will allow me to specify where the image will be inserted.

I have included the code for the VB6 test app so you can see the source code to see how its currently working.

Any suggestions would be very much appreciated.

Please Note - this is experimental code - very rough and ready - not final code by a long shot - just trying to figure out how this works with LibreOffice Writer.

To run this, you will need to create an empty vb6 app with a button.

You also need LibreOffice installed.

Many thanks

Rod.

Sub firstOOoProc()

    Dim oSM                   'Root object for accessing OpenOffice from VB
    Dim oDesk, oDoc As Object 'First objects from the API
    Dim arg()                 'Ignore it for the moment !
    
    'Instanciate OOo : this line is mandatory with VB for OOo API
    Set oSM = CreateObject("com.sun.star.ServiceManager")
    'Create the first and most important service
    Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
  
    Dim oProvider As Object
  
    Set oProvider = oSM.createInstance("com.sun.star.graphic.GraphicProvider")
  
    
    'Open an existing doc (pay attention to the syntax for first argument)
    Set oDoc = oDesk.loadComponentFromURL("file:///c:/dev/ooo/testfile.doc", "_blank", 0, arg())
  
  
    ' now - replace some text in the document
    Dim Txt
    Txt = oDoc.GetText
    
    Dim TextCursor
    TextCursor = Txt.CreateTextCursor
    
    ' attempt to replace some text 
    Dim SearchDescriptor
  
    Dim Replace
    Replace = oDoc.createReplaceDescriptor
  
    Replace.SearchString = "[TESTDATA1]"
    Replace.ReplaceString = "THIS IS A TEST"
    oDoc.replaceAll Replace
    
    Dim searchCrtiteria
    
    SearchDescriptor = oDoc.createReplaceDescriptor
  
  
    ' Now - attempt try to replace some text with an image

    SearchDescriptor.setSearchString ("[PICTUREPLACEHOLDER]")
    SearchDescriptor.SearchRegularExpression = False
    
    Dim Found
    Found = oDoc.findFirst(SearchDescriptor)
  
    ' create cursor to know where to insert the image
    Dim oCurs As Object
    
      
    Set thing = oDoc.GetCurrentController
   
    Set oCurs = thing.GetViewCursor
  
    ' make hte call to insert an image from a file into the document
    InsertImage oDoc, oCurs, "file:///c:/dev/ooo/imagefilename.jpg", oProvider

  
    'Save the doc
    Call oDoc.storeToURL("file:///c:/dev/ooo/test2.sxw", arg())

    'Close the doc
    oDoc.Close (True)
    Set oDoc = Nothing
  
    oDesk.Terminate
    Set oDesk = Nothing
  
    Set oSM = Nothing
  
  End Sub 
  
  
Function createStruct(strTypeName)
    Set classSize = objCoreReflection.forName(strTypeName)
    Dim aStruct
    classSize.CreateObject aStruct
    Set createStruct = aStruct
End Function

  Sub InsertImage(ByRef oDoc As Object, ByRef oCurs As Object, sURL As String, ByRef oProvider As Object)


         ' Init variables and instance object
        
        Dim oShape As Object
        Dim oGraph As Object
        Set oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
        Set oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
        'Set oProvider = serviceManager.CreateInstance("com.sun.star.graphic.GraphicProvider")

        ' Add shape to document
        oDoc.getDrawPage.Add oShape

        ' Set property path of picture
        Dim oProps(0) As Object
        Set oProps(0) = MakePropertyValue("URL", sURL)

        ' Get size from picture to load
        Dim oSize100thMM
        Dim lHeight As Long
        Dim lWidth As Long
        Set oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
        If Not oSize100thMM Is Nothing Then
            lHeight = oSize100thMM.Height
            lWidth = oSize100thMM.Width
        End If

        ' Set size and path property to shape
        oShape.graphic = oProvider.queryGraphic(oProps)

        ' Copy shape in graphic object and set anchor type
        oGraph.graphic = oShape.graphic
        oGraph.AnchorType = 1 'com.sun.star.Text.TextContentAnchorType.AS_CHARACTER

        ' Remove shape and resize graphix
        Dim oText As Object
        Set oText = oCurs.GetText
        oText.insertTextContent oCurs, oGraph, False
        oDoc.getDrawPage.Remove oShape
        If lHeight > 0 And lWidth > 0 Then
            Dim oSize
            oSize = oGraph.Size
            oSize.Height = lHeight * 500
            oSize.Width = lWidth * 500
            oGraph.Size = oSize
        End If
        
        

    End Sub
    
    
    '
'Converts a Ms Windows local pathname in URL (RFC 1738)
'Todo : UNC pathnames, more character conversions
'
Public Function ConvertToUrl(strFile) As String
    strFile = Replace(strFile, "\", "/")
    strFile = Replace(strFile, ":", "|")
    strFile = Replace(strFile, " ", " ")
    strFile = "file:///"   strFile
    ConvertToUrl = strFile
End Function

    '
'Creates a sequence of com.sun.star.beans.PropertyValue s
'
Public Function MakePropertyValue(cName, uValue) As Object
Dim oStruct, oServiceManager As Object
    Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
    Set oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
    oStruct.Name = cName
    oStruct.Value = uValue
    Set MakePropertyValue = oStruct
End Function


'
'A simple shortcut to create a service
'
Public Function CreateUnoService(strServiceName) As Object
Dim oServiceManager As Object
    Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
    Set CreateUnoService = oServiceManager.createInstance(strServiceName)
End Function




Public Function RecommendGraphSize(oGraph)
    Dim oSize
    Dim lMaxW As Double
    Dim lMaxH As Double
    
    lMaxW = 6.75 * 2540
    lMaxH = 9.5 & 2540
    
    If IsNull(oGraph) Or IsEmpty(oGraph) Then
        Exit Function
    End If
    
    oSize = oGraph.Size100thMM
    If oSize.Height = 0 Or oSize.Width = 0 Then
        oSize.Height = oGraph.SizePixel.Height * 2540# * Screen.TwipsPerPixelY() '/ 1440
        oSize.Width = oGraph.SizePixel.Width * 2540# * Screen.TwipsPerPixelX() '/ 1440
    End If
    If oSize.Height = 0 Or oSize.Width = 0 Then
        Exit Function
    End If
    If oSize.Width > lMaxW Then
        oSize.Height = oSizeHeight * lMax / oSize.Width
        oSize.Width = lMaxW
    End If
    If oSize.Height > lMaxH Then
        oSize.Width = oSize.Width * lMaxH / oSize.Height
        oSize.Height = lMaxH
    End If
    RecommendGraphSize = oSize
End Function


Private Sub Command1_Click()
    firstOOoProc
End Sub

The content of the testFile.Doc file is as shown below:

This is a test File

[TESTDATA1]






[PICTUREPLACEHOLDER]

CodePudding user response：

It looks like you need to move the view cursor to the found location.

Found = oDoc.findFirst(SearchDescriptor)
oVC = oDoc.getCurrentController().getViewCursor()
oVC.gotoRange(Found, False)
oVC.setString("")