Bonjour,
Voici ma solution pour redimensionner une image.
NB: l'exportation avec le service GraphicExportFilter ne permet de
régler la taille de l'image exportée que si on exporte un shape, une
collection de shapes ou une drawpage. Je n'y arrivais pas car
j'applicais la fonction Export à l'objet représentant l'image insérée.
Le principe : l'image à retailler est insérée dans un sdraw doc dont la
drawpage est retaillée à la même dimansion que l'image.
Ensuite il ne reste plus qu'à exporter la draw page en réglant les
dimensions. :-)
Encore merci à Bernard de m'avoir aiguillé sur le document d'Andrew
Pitonyak.
Si ce code peut être utile ...
Cordialement.
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 on ouvre un document sdraw invisible
Dim mFileProperties(0) As New com.sun.star.beans.PropertyValue
Dim iFormat as Integer
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 on insère dans la page l'image à redimmensionner et on fixe sa
largeur à 1000
ImageL =
monDocument.createInstance("com.sun.star.drawing.GraphicObjectShape")
ImageL.GraphicURL = ConvertToURL(sURLImage)
maPage.add(ImageL)
resizeImageByWidth(ImageL,1000)
rem on redimensionne la page du doc draw au format de l'image
iFormat = Int(ImageL.Size.Height/ImageL.Size.Width)
maPage.Width = 1000
maPage.Height = 1000*iFormat
rem on fixe les donnees du filtre d'export
Dim aFilterData (1) as new com.sun.star.beans.PropertyValue
aFilterData(0).Name = "PixelWidth" '
aFilterData(0).Value = iWidth*iFormat
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = iWidth
rem on exporte la page de dessin au format bmp
Export( maPage,sURLImageResized , aFilterData() )
On error resume Next
monDocument.Close(True)
On error goto 0
End Sub
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 en 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]
