Each one HTML exporter support image cropping (clip)
Posted: Sun Jan 19, 2020 12:17 pmWho 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:
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
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