resize
image
Dorange-Pattoret Didier
How can I resize an external from inside my OpenOffice without using any external programm.
Sub Essai
ResizeExternalImageByWidth("/home/didier/tmp4/about.bmp","/home/didier/tmp4/about_1616.bmp",16)
End sub
Sub ResizeExternalImageByWidth(sURLImage,sURLImageResized as String, iWidth as Integer)
rem open a sdraw hidden document
Dim mFileProperties(0) As New {@see com.sun.star.beans.PropertyValue}
Dim Proportion as Single
mFileProperties(0).Name="Hidden"
mFileProperties(0).Value=True
oDesktop=createUnoService("{@see com.sun.star.frame.Desktop}")
monDocument = oDesktop.LoadComponentFromURL("private:factory/sdraw","_blank",0,mFileProperties())
maPage = monDocument.DrawPages(0)
rem insert in the drawpage the image resized at 1000
ImageL = monDocument.createInstance("{@see com.sun.star.drawing.GraphicObjectShape}")
ImageL.GraphicURL = ConvertToURL(sURLImage)
maPage.add(ImageL)
resizeImageByWidth(ImageL,1000)
rem resizing the drawpage
Proportion = ImageL.Size.Height/ImageL.Size.Width
maPage.Width = 1000
maPage.Height = ArrondiEntier(1000*Proportion)
rem set export data
Dim aFilterData (1) as new {@see com.sun.star.beans.PropertyValue}
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = iWidth
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = ArrondiEntier(iWidth*Proportion)
rem export drawpage
Export( maPage,sURLImageResized , aFilterData() )
On error resume Next
monDocument.Close(True)
On error goto 0
End Sub
Function ArrondiEntier(Nombre as Single) as Integer
If Nombre-Int(Nombre) < 0.5 Then
ArrondiEntier = Int(Nombre)
Else
ArrondiEntier = Int(Nombre)+1
Endif
End Function
Sub Export( xObject, sFileUrl As String, aFilterData )
xExporter = createUnoService( "{@see com.sun.star.drawing.GraphicExportFilter}" )
xExporter.SetSourceDocument( xObject )
Dim aArgs (2) as new {@see com.sun.star.beans.PropertyValue}
Dim aURL as new {@see com.sun.star.util:URL}
sFileUrl = ConvertToURL(sFileUrl)
aArgs(0).Name = "FilterName"
aArgs(0).Value = "bmp"
aArgs(1).Name = "URL"
aArgs(1).Value = sFileUrl
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData
xExporter.filter( aArgs() )
End Sub
Sub resizeImageByWidth(uneImage As Object, largeur As Long)
Dim leBitMap As Object, Proportion As Double
Dim Taille1 As New {@see com.sun.star.awt.Size}
LeBitmap = uneImage.GraphicObjectFillBitmap
Taille1 = LeBitMap.Size ' taille in pixels !
Proportion = Taille1.Height / Taille1.Width
Taille1.Width = largeur ' largeur en 1/100 de mm
Taille1.Height = Taille1.Width * Proportion
uneImage.Size = Taille1
End Sub