Hi,
If you agree a this code allows to Resize an external image located at
"/home/didier/tmp4/about.bmp"
with your width for example 16.
Sorry for my bad english.
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 com.sun.star.beans.PropertyValue
Dim Proportion as Single
mFileProperties(0).Name="Hidden"
mFileProperties(0).Value=True
oDesktop=createUnoService("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("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 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(
"com.sun.star.drawing.GraphicExportFilter" )
xExporter.SetSourceDocument( xObject )
Dim aArgs (2) as new com.sun.star.beans.PropertyValue
Dim aURL as new 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 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
--
Didier Dorange-Pattoret
http://www.dmaths.org
http://sesamath.net
S'inscrire à la liste de diffusion de dmaths: [EMAIL PROTECTED]
Ses archives: http://listes.dmaths.org/wws/arc/users
Les Forums: http://www.dmaths.org/modules.php?name=Forums
Mailing List in english:
http://www.dmaths.org/modules.php?name=Content&pa=showpage&pid=9
Le livre de référence pour OpenOffice.org2 :
http://www.amazon.fr/exec/obidos/ASIN/2212116381/dmaths-21
Programmation OpenOffice.org2 :
http://www.amazon.fr/exec/obidos/ASIN/2212117639/dmaths-21
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
