Page 1 of 1

Each one HTML exporter support image cropping (clip)

PostPosted: Sun Jan 19, 2020 12:17 pm
by Evgeniy
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.

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


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

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,"")<>0 then
            msgbox "Warning! IMG not have SRC= reference to external image file. It is not saved!"
            if obj.AnchorType <> then
               msgbox "Warning! IMG have AncorType <> AT_PAGE. It is not saved!"
               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
               ' 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
                  cropping=cropping+" clip: rect("
                  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)         
                  imgpos=" top: "+RoundStr((obj.VertOrientPosition-obj.GraphicCrop.Top*scaley)*scale,3)+"px; left: "+_
                  imgsize=" width: "+RoundStr(obj.ActualSize.Width*scalex*scale,3)+"px; height: "+RoundStr(obj.ActualSize.Height*scaley*scale,3)+"px;"

               html=html+"<IMG NAME="""+obj.Name+""" ALT=""?"""+" SRC="""+obj.GraphicURL+""""+_
                  " STYLE=""position: absolute;"+imgpos+imgsize+cropping+""" />"+CRLF
      elseif InStr(obj.getImplementationName(),"TextFrame")<>0 then
         if obj.AnchorType <> then
            msgbox "Warning! Text DIV have AncorType <> AT_PAGE. It is not saved!"
            ' Text Frame
            Dim text As String
            Enum1 = obj.Text.createEnumeration
            ' all paragraph loop
            While Enum1.hasMoreElements
               TextElement = Enum1.nextElement
               If TextElement.supportsService("") 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>"
               End If
            '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%;"">"+_
         msgbox "Unknow type object: "+obj.getImplementationName()+" ZOrder="+obj.ZOrder+ " it is no saved."
   Next i
   Dim FilePicker As Object
   Dim FPtype(0) As Integer   
   FilePicker = CreateUnoService("")
   If FilePicker.execute() Then
      FilePickSave = ConvertToURL(FilePicker.Files(0))
      'msgbox FilePickSave
End Sub

Sub SaveFile( path As String, content As String )
   oSFA = CreateUnoService("")
   ' delete file if it exist
   If oSFA.exists(path) Then oSFA.kill(path)
   oTextoutputStream = CreateUnoService("")
   oOutputStream = oSFA.openFileWrite(path)
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
End Function

' With alpha channel support #RRGGBBAA
' For example #000000FF = black color with 100% transparency
Function LongToHTML_HexAlpha(ColorValue as Long) As String
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=red(ColorValue/256)   ' When basic support red() green() blue(), but not support alpha() function
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