[api-dev] [code snippet] resize an external image

[Didier Dorange-Pattoret]

Hi,

The code.

--
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


<?xml version="1.0"?>
<!--
$RCSfile: $
last change: $Revision: $ $Author: $ $Date: $

(c)2003 by the copyright holders listed with the author-tags.
If no explicit copyright holder is mentioned with a certain author,
the author him-/herself is the copyright holder. All rights reserved.

Public Documentation License Notice:

The contents of this Documentation are subject to the
Public Documentation License Version 1.0 (the "License");
you may only use this Documentation if you comply with
the terms of this License. A copy of the License is
available at http://www.openoffice.org/licenses/PDL.html

The Original Documentation can be found in the CVS archives
of openoffice.org at the place specified by RCSfile: in this header.

The Initial Writer(s) of the Original Documentation are listed
with the author-tags below.

The Contributor(s) are listed with the author-tags below
without the marker for being an initial author.

All Rights Reserved.
-->

<snippet language="OOBasic" application="Office">

<keywords>
	<keyword>resize</keyword>
	<keyword>image</keyword>
</keywords>

<authors>
	<author id="ddorange" initial="true" email="[EMAIL PROTECTED]" copyright="LGPL">Dorange-Pattoret Didier</author>
</authors>

<question heading="resize an external image">
<listing>Sub Essai
ResizeExternalImageByWidth(&quot;/home/didier/tmp4/about.bmp&quot;,&quot;/home/didier/tmp4/about_1616.bmp&quot;,16)
End sub


Sub ResizeExternalImageByWidth(sURLImage,sURLImageResized as String, iWidth as Integer)
   rem open a sdraw hidden document
   Dim mFileProperties(0) As New [EMAIL PROTECTED] com.sun.star.beans.PropertyValue}
   Dim Proportion as Single
   mFileProperties(0).Name=&quot;Hidden&quot;
   mFileProperties(0).Value=True
   oDesktop=createUnoService(&quot;[EMAIL PROTECTED] com.sun.star.frame.Desktop}&quot;)
   monDocument = oDesktop.LoadComponentFromURL(&quot;private:factory/sdraw&quot;,&quot;_blank&quot;,0,mFileProperties())
   maPage = monDocument.DrawPages(0)
   rem insert in the drawpage the image resized at 1000
   ImageL = monDocument.createInstance(&quot;[EMAIL PROTECTED] com.sun.star.drawing.GraphicObjectShape}&quot;)
   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 [EMAIL PROTECTED] com.sun.star.beans.PropertyValue}
      aFilterData(0).Name  = &quot;PixelWidth&quot;        &apos;
     aFilterData(0).Value = iWidth
      aFilterData(1).Name  = &quot;PixelHeight&quot;
      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) &lt; 0.5 Then
ArrondiEntier = Int(Nombre)
Else
ArrondiEntier = Int(Nombre)+1
Endif
End Function



Sub Export( xObject, sFileUrl As String, aFilterData )
  xExporter = createUnoService( &quot;[EMAIL PROTECTED] com.sun.star.drawing.GraphicExportFilter}&quot; )
  xExporter.SetSourceDocument( xObject )
  Dim aArgs (2) as new [EMAIL PROTECTED] com.sun.star.beans.PropertyValue}
  Dim aURL as new [EMAIL PROTECTED] com.sun.star.util:URL}
   sFileUrl = ConvertToURL(sFileUrl)
  aArgs(0).Name  = &quot;FilterName&quot;
  aArgs(0).Value = &quot;bmp&quot;
  aArgs(1).Name  = &quot;URL&quot;
  aArgs(1).Value = sFileUrl
  aArgs(2).Name  = &quot;FilterData&quot;
  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 [EMAIL PROTECTED] com.sun.star.awt.Size}
   LeBitmap = uneImage.GraphicObjectFillBitmap
   Taille1 = LeBitMap.Size &apos; taille in pixels !
   Proportion = Taille1.Height / Taille1.Width
   Taille1.Width = largeur &apos; largeur en 1/100 de mm
   Taille1.Height = Taille1.Width * Proportion
   uneImage.Size = Taille1
End Sub
</listing>
</question>

<answer>
</answer>

<versions>
</versions>

<operating-systems>
<operating-system name="All"/>
</operating-systems>

<changelog>
</changelog>

</snippet>


---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]