LibreOffice Writer API 游标和文本选择/替换从VB6

2022-10-12 14:39:43标签apivb6libreofficewriter
提问

我一直试图用LibreOffice在vb6应用程序中替换Office OLE。 我已经取得了一些成功,但我正在短暂地寻找文本,然后根据文本中发现的文本创建一个游标,然后在文档中插入一个图像。 我已经能够将工作代码拼凑起来,让我搜索文本替换文本,并插入一个图像,但我似乎不能弄清楚如何创建一个游标,它将允许我以我发现的文本的速度插入图像。在提供的示例中,文档中(pictureplace eholder)文本。 有没有人以前做过这个,他们有任何建议我可以创建一个游标,它允许我指定图像的插入位置。 我已经将VB6测试应用程序的代码包括在内,这样您就可以看到源代码来了解它目前的工作方式了。 任何建议都将不胜感激。 请注意——这是实验代码——非常粗糙,而且准备好了——不是最后的代码——只是试图弄清楚如何与LibreOffice作家一起工作。 要运行这个,您需要创建一个带有按钮的空vb6应用程序。 你也需要安装LibreOffice。 非常感谢 棒。 testFile的内容。Doc文件如下图所示: 看起来您需要将视图光标移动到被发现的位置。

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, " ", "%20")
    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

This is a test File
[TESTDATA1]
[PICTUREPLACEHOLDER]
回答

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

▼版权说明

相关文章也很精彩
推荐内容
更多标签
相关热门
全站排行
随便看看

错说cuoshuo.com——程序员的报错记录

部分内容根据CC版权协议转载,如果您希望取消转载请发送邮件到cuoshuo8@163.com

辽ICP备19011660号-5