Re: [prog] Comment obtnir la version de Windows

Didier Dorange-Pattoret Mon, 30 Jan 2006 14:10:24 -0800

Bonsoir Laurent,

Voici les macros qui permettent de redimensionner le fichier about.bmp, en gardant ses proportions et en lui donnant une largeur de 16.

Si ce code est potentiellement utile je peux le mettre en ligne. Je l'ai publié sur oooforums.org

http://www.oooforum.org/forum/viewtopic.phtml?t=30260&highlight=

Dans Dmaths, il sert à personnaliser les icônes des applications préférées de l'utilisateur.

Version en développement : http://ddorange.free.fr/Dmaths31Alpha2.zip

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

Re: [prog] Comment obtnir la version de Windows

Répondre à