Генерация HTML таблиц
Code
Enumeration
#FT_Align_Right
#FT_Align_Center
#FT_Align_Left
EndEnumeration
Structure FormattedText
text.s
bgColor.s
fontColor.s
fontSize.i
font.s
align.i ;left/right/center
EndStructure
Procedure.s HTMLcomment(txt.s)
;returns text commented out the HTML way
ProcedureReturn "<!-- " + txt + " -->"
EndProcedure
Procedure HTML_PrintTable(Array arr.FormattedText(2), nFile.i, nWidth.i = 35, class.s="", firstRowIsHdr.i = 0)
Protected nr.i
Protected nc.i
Protected Padding.i=1
Protected line.s
Protected RowColor1.s = "FFFF99"
Protected RowColor2.s = "FFFFCC"
If Not nFile : ProcedureReturn : EndIf
line = "<table"
If class
line = line + " class=" + #DQUOTE$ + class + #DQUOTE$
EndIf
line = line + " border=1 width=" + Str(nWidth) + "%>"
WriteStringN(nFile,line)
line = ""
WriteStringN(nFile,HTMLcomment("Start loop for rows"))
For nr = 0 To ArraySize(arr(),2)
If Not firstRowIsHdr
If nr%2 = 1
WriteStringN(nFile,"<tr bgcolor=" + Chr(34) + RowColor1 + Chr(34) + ">")
Else
WriteStringN(nFile,"<tr bgcolor=" + Chr(34) + RowColor2 + Chr(34) + ">")
EndIf
Else
WriteStringN(nFile,"<th>")
EndIf
WriteStringN(nFile,HTMLcomment("loop for column cells"))
For nc = 0 To ArraySize(arr(),1)
line = "<td padding=" + Str(Padding)
If class
line = line + " class=" + #DQUOTE$ + class + #DQUOTE$
EndIf
If arr(nc,nr)\bgColor
line = line + " bgcolor=" + #DQUOTE$ + arr(nc,nr)\bgColor + #DQUOTE$
EndIf
Select arr(nc,nr)\align
Case #FT_Align_Center
line = line + " align=" + #DQUOTE$ + "center" + #DQUOTE$
Case #FT_Align_Left
line = line + " align=" + #DQUOTE$ + "left" + #DQUOTE$
Case #FT_Align_Right
line = line + " align=" + #DQUOTE$ + "right" + #DQUOTE$
Default
EndSelect
line = line + ">"
If arr(nc,nr)\font Or arr(nc,nr)\fontSize Or arr(nc,nr)\fontColor
line = line + "<font"
If arr(nc,nr)\font
line = line + " " + arr(nc,nr)\font
EndIf
If arr(nc,nr)\fontSize
line = line + " size=" + Str(arr(nc,nr)\fontSize)
EndIf
If arr(nc,nr)\fontColor
line = line + " color=" + arr(nc,nr)\fontColor
EndIf
line = line + ">"
EndIf
line = line + arr(nc,nr)\text
If arr(nc,nr)\font Or arr(nc,nr)\fontSize Or arr(nc,nr)\fontColor
line = line + "</font>"
EndIf
line = line + "</td>"
WriteStringN(nFile,line)
line = ""
Next nc
If Not firstRowIsHdr
WriteStringN(nFile,"</tr>")
Else
WriteStringN(nFile,"</th>")
EndIf
Next nr
WriteStringN(nFile,"</table>")
EndProcedure
Dim html.FormattedText(9,9)
For c.i = 0 To 9
For r.i = 0 To 9
With html(c,r)
\text = "row: " + Str(r) + ", col: " + Str(c)
\align = #FT_Align_Center
\fontColor = "blue"
EndWith
Next r
Next c
fname.s = GetTemporaryDirectory() + "html_output.htm"
fnum.i = CreateFile(#PB_Any, fname)
If fnum
WriteStringN(fnum,"<html><title>test</title><body>")
HTML_PrintTable(html(),fnum)
WriteStringN(fnum,"</body></html>")
CloseFile(fnum)
RunProgram("notepad.exe",fname,GetTemporaryDirectory())
EndIf
#FT_Align_Right
#FT_Align_Center
#FT_Align_Left
EndEnumeration
Structure FormattedText
text.s
bgColor.s
fontColor.s
fontSize.i
font.s
align.i ;left/right/center
EndStructure
Procedure.s HTMLcomment(txt.s)
;returns text commented out the HTML way
ProcedureReturn "<!-- " + txt + " -->"
EndProcedure
Procedure HTML_PrintTable(Array arr.FormattedText(2), nFile.i, nWidth.i = 35, class.s="", firstRowIsHdr.i = 0)
Protected nr.i
Protected nc.i
Protected Padding.i=1
Protected line.s
Protected RowColor1.s = "FFFF99"
Protected RowColor2.s = "FFFFCC"
If Not nFile : ProcedureReturn : EndIf
line = "<table"
If class
line = line + " class=" + #DQUOTE$ + class + #DQUOTE$
EndIf
line = line + " border=1 width=" + Str(nWidth) + "%>"
WriteStringN(nFile,line)
line = ""
WriteStringN(nFile,HTMLcomment("Start loop for rows"))
For nr = 0 To ArraySize(arr(),2)
If Not firstRowIsHdr
If nr%2 = 1
WriteStringN(nFile,"<tr bgcolor=" + Chr(34) + RowColor1 + Chr(34) + ">")
Else
WriteStringN(nFile,"<tr bgcolor=" + Chr(34) + RowColor2 + Chr(34) + ">")
EndIf
Else
WriteStringN(nFile,"<th>")
EndIf
WriteStringN(nFile,HTMLcomment("loop for column cells"))
For nc = 0 To ArraySize(arr(),1)
line = "<td padding=" + Str(Padding)
If class
line = line + " class=" + #DQUOTE$ + class + #DQUOTE$
EndIf
If arr(nc,nr)\bgColor
line = line + " bgcolor=" + #DQUOTE$ + arr(nc,nr)\bgColor + #DQUOTE$
EndIf
Select arr(nc,nr)\align
Case #FT_Align_Center
line = line + " align=" + #DQUOTE$ + "center" + #DQUOTE$
Case #FT_Align_Left
line = line + " align=" + #DQUOTE$ + "left" + #DQUOTE$
Case #FT_Align_Right
line = line + " align=" + #DQUOTE$ + "right" + #DQUOTE$
Default
EndSelect
line = line + ">"
If arr(nc,nr)\font Or arr(nc,nr)\fontSize Or arr(nc,nr)\fontColor
line = line + "<font"
If arr(nc,nr)\font
line = line + " " + arr(nc,nr)\font
EndIf
If arr(nc,nr)\fontSize
line = line + " size=" + Str(arr(nc,nr)\fontSize)
EndIf
If arr(nc,nr)\fontColor
line = line + " color=" + arr(nc,nr)\fontColor
EndIf
line = line + ">"
EndIf
line = line + arr(nc,nr)\text
If arr(nc,nr)\font Or arr(nc,nr)\fontSize Or arr(nc,nr)\fontColor
line = line + "</font>"
EndIf
line = line + "</td>"
WriteStringN(nFile,line)
line = ""
Next nc
If Not firstRowIsHdr
WriteStringN(nFile,"</tr>")
Else
WriteStringN(nFile,"</th>")
EndIf
Next nr
WriteStringN(nFile,"</table>")
EndProcedure
Dim html.FormattedText(9,9)
For c.i = 0 To 9
For r.i = 0 To 9
With html(c,r)
\text = "row: " + Str(r) + ", col: " + Str(c)
\align = #FT_Align_Center
\fontColor = "blue"
EndWith
Next r
Next c
fname.s = GetTemporaryDirectory() + "html_output.htm"
fnum.i = CreateFile(#PB_Any, fname)
If fnum
WriteStringN(fnum,"<html><title>test</title><body>")
HTML_PrintTable(html(),fnum)
WriteStringN(fnum,"</body></html>")
CloseFile(fnum)
RunProgram("notepad.exe",fname,GetTemporaryDirectory())
EndIf
www.purebasic.info/
www.purebasic.com
www.purebasic.mybb.ru
www.www.purebasic.fr/english
www.www.purebasic.fr/german
Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.
