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