Re: [Rendering] Trying to render text page to a bitmap

[Ariel Constenla-Haile]

Hi Erik,

On Wed, May 30, 2012 at 11:20:23AM +0200, Erik Wigforss wrote:
> Hi,
> 
> Thanks for the code but it doesn't work.
> 
> Heres my code to anser every question one will ever have about ooo.
> 
> Sub TheAnswerForEveryting()
> 
> If isDepressed() Then
>   doNothing()
> ElseIf isHappy() Then
>   doSomething()
> ElseIf isHatred() Then
>  crashForNoReason()
> ElseIf isPolite() Then
>   throwAnError()
> Else
>   waitForOneSecondAndTryAgain()
> End If
> End Sub

That made me laugh :)

You can find a way how to use XRenderable here:
http://people.apache.org/~arielch/api/XRenderable/
The Basic code in the Writer document produces the two PNG images.


REM  *****  BASIC  *****

Option Explicit

Sub Main
    GlobalScope.BasicLibraries.loadLibrary("Tools")
    Dim oDoc as Object
    oDoc = ThisComponent
    
    
    If HasUnoInterfaces(oDoc, "com.sun.star.view.XRenderable") Then
        Dim sBaseURL as String
        sBaseURL = DirectoryNameOutOfPath(oDoc.getURL(), "/")
        
        Dim oSFA as Object
        oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
        Dim oGraphicProvider as Object
        oGraphicProvider = 
CreateUnoService("com.sun.star.graphic.GraphicProvider")
        
        Dim oController as Object
        Dim oUnitConverter as Object
        oController = oDoc.getCurrentController()
        oUnitConverter = oController.getFrame().getComponentWindow()
        
        Dim oSelection as Object
        ' it could be the whole document
        oSelection = oDoc
        
        ' or the selection
        'Dim oTextCursor as Object
        'oTextCursor = 
oDoc.getText().createTextCursorByRange(oDoc.getText().getStart())
        'oTextCursor.goToRange(oDoc.getText().getEnd(), True)       
        'oController.select(oTextCursor)
        'oSelection = oController.getSelection()
        
        Dim oDevice as Object
        Dim aRenderOptions(5) as New com.sun.star.beans.PropertyValue
        aRenderOptions(0).Name  = "RenderDevice"
        aRenderOptions(0).Value = oDevice
        aRenderOptions(1).Name  = "ExportNotesPages"
        aRenderOptions(1).Value = False
        aRenderOptions(2).Name  = "IsFirstPage"
        aRenderOptions(2).Value = True
        aRenderOptions(3).Name  = "IsLastPage"
        aRenderOptions(3).Value = False
        aRenderOptions(4).Name  = "IsSkipEmptyPages"
        aRenderOptions(4).Value = True
        aRenderOptions(5).Name  = "PageRange"
        aRenderOptions(5).Value = ""

        
        Dim nPageCount as Integer
        nPageCount = oDoc.getRendererCount( oSelection, aRenderOptions )
        If nPageCount > 0 Then
            Dim oToolkit as Object
            oToolkit = CreateUnoService("com.sun.star.awt.Toolkit")
            
            Dim oRenderer as Object
            Dim oPageSize as Object
            Dim i%
            Dim sURL$
            
            While nPageCount > 0
                nPageCount = nPageCount - 1
                oRenderer = oDoc.getRenderer(nPageCount, oSelection, 
aRenderOptions)
                For i = 0 To UBound(oRenderer)
                    If oRenderer(i).Name = "PageSize" Then
                        oPageSize = oRenderer(i).Value
                        Exit For
                    End If
                Next
            
                Dim oDeviceSize as Object
                oDeviceSize = oUnitConverter.convertSizeToPixel(oPageSize, 
com.sun.star.util.MeasureUnit.MM_100TH)
                oDevice = oToolkit.createScreenCompatibleDevice( 
oDeviceSize.Width, oDeviceSize.Height)
                aRenderOptions(0).Value = oDevice
                oDoc.render( nPageCount, oSelection, aRenderOptions)
            
                Dim oBitmap as Object
                oBitmap = oDevice.createBitmap( 0, 0, 
oDevice.Info.Width,oDevice.Info.Height)
                
                sURL = sBaseURL + "/" + CStr(nPageCount) + ".png"
                If oSFA.exists(sURL) Then oSFA.kill(sURL)
                StoreBitmapToURL(oGraphicProvider, oBitmap, sURL)
            Wend
        End If
    End If
End Sub

Sub StoreBitmapToURL(oGraphicProvider, oBitmap, sURL)
    Dim oMediaProperties(0) as New com.sun.star.beans.PropertyValue
    oMediaProperties(0).Name  = "Bitmap"
    oMediaProperties(0).Value = oBitmap
    
    Dim oGraphic as Object
    oGraphic = oGraphicProvider.queryGraphic(oMediaProperties)
    
    If NOT IsNull(oGraphic) Then
        Dim oMediaPropertiesOut(2) as New com.sun.star.beans.PropertyValue
        oMediaPropertiesOut(0).Name  = "URL"
        oMediaPropertiesOut(0).Value = sURL
        oMediaPropertiesOut(1).Name  = "MimeType"
        oMediaPropertiesOut(1).Value = "image/png"
        
        oGraphicProvider.storeGraphic(oGraphic, oMediaPropertiesOut)
    End If
End Sub



Regards
-- 
Ariel Constenla-Haile
La Plata, Argentina

pgpU2Eit2sUHz.pgp
Description: PGP signature