Each one HTML exporter support image cropping (clip)

Creating Extension - Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This forum is not for asking questions about writing your own macros.

Each one HTML exporter support image cropping (clip)

Postby Evgeniy » Sun Jan 19, 2020 12:17 pm

Who know sources and C++ can add this cropping feature to Writer source code :)

How it work?
Make odt writer document add images and text, and save it as html file by this scriprt.

Support:
valid tags zOrdering
valid image cropping (cliping) STYLE clip: rect() as CSS 3.0 support feature
save all data in pixel coordinates (px) ... in hundredths of a pixel.
save text in unicode utf-8 format

Example of output HTML code:
Code: Select all   Expand viewCollapse view
<HTML><BODY>
<IMG NAME="Object1" ALT="?" SRC="file:///C:/Test/Villeroy.png" STYLE="position: absolute; top: 163.011px; left: 166.337px; width: 133.342px; height: 130.583px;" />
<IMG NAME="Object2" ALT="?" SRC="file:///C:/Test/Villeroy.png" STYLE="position: absolute; top: 39.005px; left: 365.329px; width: 281.726px; height: 297.071px;" />
<DIV ID="1.2RU" ALT="?" STYLE="position: absolute; top: 439.408px; left: 415.861px; width: 194.192px; height: 44.674px; background-color: #111111FF;">
   <P STYLE="margin-top: 0pt; margin-bottom: 0pt; line-height: 115%;"><FONT COLOR="#00A933">►</FONT><FONT COLOR="#FFFFFF"> </FONT><FONT COLOR="#FF3300">this colored text </FONT></P>

...
</DIV>


Suport what is in Wrter exporter:
font color
only textframes and images
only at_page absolute position

Unsupport:
body paragraph text and objects
intext position objects only absolute at page
tables and each other

Code: Select all   Expand viewCollapse view

' ToDo
' support ALT=
' support font face
' support font size
' support <A> links
' base font style
' background color

Sub SaveAsHTMLPage()
   Dim CRLF As String
   Dim html As String
   CRLF = chr(13)+chr(10)
   
   Dim scale as Double
   scale=0.0377952755905512 '1/100 mm to pixels
   
   ' loop of view all objects in zOrder
   view = ThisComponent.getCurrentController()
   dp = ThisComponent.DrawPage
   
   For i = 0 to dp.getCount() -1
      obj = dp.getByIndex(i)
      
      if InStr(obj.getImplementationName(),"GraphicObject")<>0 then
         ' Image
         if InStr(obj.GraphicURL,"vnd.sun.star.GraphicObject")<>0 then
            view.select(obj)
            msgbox "Warning! IMG not have SRC= reference to external image file. It is not saved!"
         else
            if obj.AnchorType <> com.sun.star.text.TextContentAnchorType.AT_PAGE then
               view.select(obj)
               msgbox "Warning! IMG have AncorType <> AT_PAGE. It is not saved!"
            else
               Dim imgsize As String
               imgsize=" width: "+RoundStr(obj.Width*scale,3)+"px; height: "+RoundStr(obj.Height*scale,3)+"px;"
               Dim imgpos As String
               imgpos=" top: "+RoundStr(obj.VertOrientPosition*scale,3)+"px; left: "+RoundStr(obj.HoriOrientPosition*scale,3)+"px;"
            
               Dim cropping As String
               cropping=""
               ' If image cropped change data
               if obj.GraphicCrop.Left<>0 or obj.GraphicCrop.Right<>0 or obj.GraphicCrop.Top<>0 or obj.GraphicCrop.Bottom<>0 then

                  Dim scalex,scaley As Double
                  scalex=obj.Width/(obj.ActualSize.Width-obj.GraphicCrop.Left-obj.GraphicCrop.Right)
                  scaley=obj.Height/(obj.ActualSize.Height-obj.GraphicCrop.Top-obj.GraphicCrop.Bottom)
   
                  cropping=cropping+" clip: rect("
                  cropping=cropping+RoundStr(obj.GraphicCrop.Top*scaley*scale,3)+"px,"
                  cropping=cropping+RoundStr((obj.ActualSize.Width-obj.GraphicCrop.Right)*scalex*scale,3)+"px,"
                  cropping=cropping+RoundStr((obj.ActualSize.Height-obj.GraphicCrop.Bottom)*scaley*scale,3)+"px,"
                  cropping=cropping+RoundStr(obj.GraphicCrop.Left*scalex*scale,3)+"px);"
                  cropping=cropping+" overflow: hidden;"      '   !!!
                  
                  'msgbox " actual x width="+RoundStr(obj.ActualSize.Width,3)+_
                  '" actual y height="+RoundStr(obj.ActualSize.Height,3)+_
                  '" xs width="+RoundStr(obj.Width,3)+_
                  '" ys height="+RoundStr(obj.Height,3)+_
                  '" xleft crop left="+RoundStr(obj.GraphicCrop.Left,3)+_
                  '" ytop crop top="+RoundStr(obj.GraphicCrop.Top,3)+_
                  '" ydown crop bottom="+RoundStr(obj.GraphicCrop.Bottom,3)+_
                  '" xright crop right="+RoundStr(obj.GraphicCrop.Right,3)+_
                  '" actual croped width="+RoundStr(obj.ActualSize.Width-obj.GraphicCrop.Left-obj.GraphicCrop.Right,3)+_
                  '" actual croped height="+RoundStr(obj.ActualSize.Height-obj.GraphicCrop.Top-obj.GraphicCrop.Bottom,3)+_
                  '" widthscale="+RoundStr(obj.Width/(obj.ActualSize.Width-obj.GraphicCrop.Left-obj.GraphicCrop.Right),8)+_
                  '" heightscale="+RoundStr(obj.Height/(obj.ActualSize.Height-obj.GraphicCrop.Top-obj.GraphicCrop.Bottom),8)         
                  
                  'end
                  imgpos=" top: "+RoundStr((obj.VertOrientPosition-obj.GraphicCrop.Top*scaley)*scale,3)+"px; left: "+_
                  RoundStr((obj.HoriOrientPosition-obj.GraphicCrop.Left*scalex)*scale,3)+"px;"
                  imgsize=" width: "+RoundStr(obj.ActualSize.Width*scalex*scale,3)+"px; height: "+RoundStr(obj.ActualSize.Height*scaley*scale,3)+"px;"
               endif   

               html=html+"<IMG NAME="""+obj.Name+""" ALT=""?"""+" SRC="""+obj.GraphicURL+""""+_
                  " STYLE=""position: absolute;"+imgpos+imgsize+cropping+""" />"+CRLF
            endif
            
         endif
      elseif InStr(obj.getImplementationName(),"TextFrame")<>0 then
         if obj.AnchorType <> com.sun.star.text.TextContentAnchorType.AT_PAGE then
            view.select(obj)
            msgbox "Warning! Text DIV have AncorType <> AT_PAGE. It is not saved!"
         else
            ' Text Frame
            Dim text As String
            text=""
            Enum1 = obj.Text.createEnumeration
            ' all paragraph loop
            While Enum1.hasMoreElements
               TextElement = Enum1.nextElement
               If TextElement.supportsService("com.sun.star.text.Paragraph") Then
                  Enum2 = TextElement.createEnumeration
                  ' all sub paragraph loop
                  While Enum2.hasMoreElements
                     TextPortion = Enum2.nextElement
                     ' rgb(,,) format not work in writer and firefox
                     text=text+"<FONT COLOR="""+LongToHTML_Hex(TextPortion.CharColor)+""">"+TextPortion.String+"</FONT>"
                  Wend
               End If
            Wend
      
            'alternative string
            html=html+"<DIV ID="""+obj.Name+""" ALT=""?"""+_
               " STYLE=""position: absolute; top: "+RoundStr(obj.VertOrientPosition*scale,3)+"px; left: "+RoundStr(obj.HoriOrientPosition*scale,3)+"px;"+_
               " width: "+RoundStr(obj.Width*scale,3)+"px; height: "+RoundStr(obj.Height*scale,3)+"px;"+_
               " background-color: "+LongToHTML_HexUni(obj.BackColor,obj.BackColorTransparency)+";"+_
               """>"+CRLF+chr(9)+"<P STYLE=""margin-top: 0pt; margin-bottom: 0pt; line-height: 115%;"">"+_
               text+_
               "</P>"+CRLF+"</DIV>"+CRLF
         endif      
      else   
         msgbox "Unknow type object: "+obj.getImplementationName()+" ZOrder="+obj.ZOrder+ " it is no saved."
      endif   
   Next i
   
   Dim FilePicker As Object
   Dim FPtype(0) As Integer   
   FilePicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
   FPtype(0)=com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE
   FilePicker.initialize(FPtype())
   If FilePicker.execute() Then
      FilePickSave = ConvertToURL(FilePicker.Files(0))
      'msgbox FilePickSave
   EndIf
      
   SaveFile(FilePickSave,"<HTML><BODY>"+CRLF+html+"</BODY></HTML>")
End Sub

Sub SaveFile( path As String, content As String )
   oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
   ' delete file if it exist
   If oSFA.exists(path) Then oSFA.kill(path)
   oTextoutputStream = CreateUnoService("com.sun.star.io.TextOutputStream")
   oOutputStream = oSFA.openFileWrite(path)
   oTextoutputStream.setOutputStream(oOutputStream)
   oTextoutputStream.writeString(content)
   oTextoutputStream.closeOutput()
End Sub

' Convert Long color value to HTML HEX color for example "#0ffa56"
' If used in HTML tag for example <FONT COLOR> tag use aditional ""
' If used in CSS STYLE for example background-color: not use ""
Function LongToHTML_Hex(ColorValue as Long) As String
   LongToHTML_Hex="#"+Right("0"+Hex(red(ColorValue)),2)+Right("0"+Hex(green(ColorValue)),2)+Right("0"+Hex(blue(ColorValue)),2)
End Function

' With alpha channel support #RRGGBBAA
' For example #000000FF = black color with 100% transparency
Function LongToHTML_HexAlpha(ColorValue as Long) As String
   LongToHTML_HexAlpha="#"+Right("0"+Hex(red(ColorValue)),2)+Right("0"+Hex(green(ColorValue)),2)+Right("0"+Hex(blue(ColorValue)),2)+_
   Right("0"+Hex(red(ColorValue/256)),2)
End Function

' This function use with transparency
Function LongToHTML_HexUni(ColorValue as Long, Transp As Long) As String
   Dim alpha as Long
   if Transp=0 then
      alpha=255
   else
      alpha=red(ColorValue/256)   ' When basic support red() green() blue(), but not support alpha() function
   endif
   LongToHTML_HexUni="#"+Right("0"+Hex(red(ColorValue)),2)+Right("0"+Hex(green(ColorValue)),2)+Right("0"+Hex(blue(ColorValue)),2)+_
   Right("0"+Hex(alpha),2)
End Function

' Math rounding functions

Function Round(val As Double,digits_after_point As Integer) As Double
   Round = CDbl(CLng(val*(10^digits_after_point)))/(10^digits_after_point)
End Function

Function RoundStr(val As Double,digits_after_point As Integer) As String
   RoundStr = Replace(""+CDbl(CLng(val*(10^digits_after_point)))/(10^digits_after_point),",",".")
End Function
Attachments
Writer.jpg
View in Writer editor
FireFox.jpg
View in FireFox
Test.zip
Archive with sources
(29.16 KiB) Downloaded 65 times
OpenOffice 4.1.7 OS: Win10 x32 + Win10 x64
User avatar
Evgeniy
 
Posts: 43
Joined: Thu Jan 09, 2020 9:31 pm
Location: Russia

Return to Code Snippets

Who is online

Users browsing this forum: No registered users and 1 guest