'  clsHtmlWriter  -  class with routines to create HTML output
'
'  A1880
'
'
'  History:
'
'  0.0  A1880  08-Oct-2002  1st draft
'       A1880  28-Dec-2002  ported from Evaluation to Dictionary
'       A1880  06-Sep-2009  ported from VB6 to Jabaco
'
Option Explicit

Private reportFile As String
Private reportWriter As java#io#PrintWriter

Private htmlOutputLines As Long
Private started As Long
Private VMLNamespace As String
Private htmlBuffer As String

Public Function cr2br(s As String) As String
'  convert carriage return characters into <BR>
    Dim pos As Integer
    Dim posMax As Integer
    Dim t As String
    Dim c As String
    
    posMax = Len(s)
    t = ""
    For pos = 1 To posMax
        c = Mid(s, pos, 1)
        If Asc(c) < 32 Then
            If c = vbCr Then
                c = "<BR>"
            ElseIf c = vbLf Then
                c = ""
            Else
                c = "[0x" & Hex(Asc(c)) & "]"
            End If
        End If
        t = t & c
    Next pos
    cr2br = t
End Function


Public Function escapeXML(s As String) As String
    Dim ret As String
    
    ret = Replace(s, Chr(34), "&quote;")
    ret = Replace(ret, "'", "&apos;")
    ret = Replace(ret, "-", "-")
    ret = Replace(ret, "&", "&amp;")
    ret = Replace(ret, ">", "&gt;")
    ret = Replace(ret, "<", "&lt;")

    escapeXML = ret
End Function

Private Sub generateHtmlStyleForVML()
    html "<style>"
    htmlComment "reference to Microsoft's VML rendering engine"
    htmlComment "'behaviour' is spelled 'behavior' in the US and in Redmond ..."
    html VMLNamespace + "\:* { behavior: url(#default#VML); }"

    htmlComment "added for Office extensions"
    html "o\:* { behavior: url(#default#VML);}"

    html "</style>"
End Sub

Public Sub html(s As String)
    If Left(s, 1) = ">" Then
        htmlBuffer = htmlBuffer & Mid(s, 2)
    ElseIf htmlBuffer <> "" Then
        If Len(s) + Len(htmlBuffer) > 72 Then
            reportWriter.println htmlBuffer
            htmlBuffer = s
        Else
            htmlBuffer = htmlBuffer & vbCrLf & s
        End If
    Else
        htmlBuffer = s
    End If
    
    If (s = "") Or (Len(htmlBuffer) > 72) Then
        reportWriter.println htmlBuffer
        htmlOutputLines = htmlOutputLines + 1
        htmlBuffer = ""
    End If
End Sub


Public Sub htmlBox(left As Integer, top As Integer, _
                   txt As String, title As String)
    html "<DIV style=" _
        & quote("border:none; background-color:#FFEEDD; position:absolute; top:" & _
                top & "%; left:" & left & "%; width:auto;") & ">"
    If title <> "" Then
        html "<P title=" & quote(title) & ">" & txt & "</P>"
    Else
        html "<P>" & txt & "</P>"
    End If
    html "</DIV>"
End Sub


Public Sub htmlCellA(s As String, attr As String)
    If s = "" Then _
        s = "&nbsp;"
    If attr = "" Then
        html "<TD>" & s & "</TD>"
    Else
        html "<TD " & attr & ">" & s & "</TD>"
    End If
        
End Sub


Public Sub htmlCell(s As String)
    If s = "" Then _
        s = "&nbsp;"
    html "<TD>" & s & "</TD>"
End Sub


Public Sub htmlCellCenter(s As String)
   htmlCellAligned s, "center"
End Sub


Public Sub htmlCellLeft(s As String)
   htmlCellAligned s, "left"
End Sub


Public Sub htmlCellRight(s As String)
   htmlCellAligned s, "right"
End Sub


Public Sub htmlCellAligned(s As String, dir As String)
    If (s = "") Or (dir = "") Then
         htmlCell(s)
    Else
         html "<TD align=" & quote(dir) & ">" & s & "</TD>"
    End If
End Sub

Public Sub htmlComment(s As String)
    html "<!-- " & s & " -->"
End Sub

Public Sub htmlFooter(bEnglish As Boolean, showIt As Boolean)
  Dim stopped As Long  = GetTickCount()
  Dim elapsed As Long = stopped - started
  Dim sElapsed As String = Round(0.001 * elapsed, 3)
  Dim df As SimpleDateFormat 
  
  df = New SimpleDateFormat("dd-MMM-yyyy HH:mm", IIF(bEnglish, Locale.ENGLISH, Locale.GERMAN) )
    
  If bEnglish Then
    sElapsed = Replace(sElapsed, ",", ".")
  End If
  
  html "<P>"
  html "<FONT size=-1>"
  html IIF(bEnglish, "created ", "erzeugt ")
  html "in " & sElapsed & "s, "  
  html df.format(New java#util#Date)
  html IIF(bEnglish, "by a hand-crafted tool of ", "durch ein Programm aus der Feder von ")
  html "<A href='mailto:xxx@yyy.com'>"
  html "xxx@yyy.com</A>"
  html "</FONT>"
  html "</BODY>"
  html "</HTML>"
  html ""   '  flush htmlBuffer
  reportWriter.flush 
  reportWriter.close 
  
  If (htmlOutputLines > 0) And showIt Then
      htmlShow reportFile
  End If
End Sub


Public Sub htmlHeader(title As String, sHtmlFileName As String, Optional useSmallFont As Boolean = False)
    Dim df As SimpleDateFormat = New SimpleDateFormat("dd-MMM-yyyy HH:mm")
    Dim f As java#io#File 
    
    htmlOutputLines = 0
    reportFile = sHtmlFileName
    
    f = New File(reportFile)

			reportWriter = New java#io#PrintWriter(New java#io#BufferedWriter(New java#io#FileWriter(f)))
			reportFile = f.getAbsolutePath()

    htmlComment "(C) xxxx, " & _
        df.format(New java#util#Date)
        
    ' we have to add the namespace, if there
    ' is a namespace definition
    If VMLNamespace = "" Then
        html "<HTML>"
    Else
        html "<HTML xmlns:" & VMLNamespace & "=" & quote("urn:schemas-microsoft-com:vml") & ">"
    End If

    html "<HEAD>"
    html "<TITLE>" & title & "</TITLE>"
    htmlStyle useSmallFont
    If VMLNamespace <> "" Then
        generateHtmlStyleForVML
    End If
    html "</HEAD>"
    html "<BODY>"
End Sub


Public Sub htmlInit()
    started = GetTickCount()
End Sub


Public Sub htmlShow(fileName As String)
   Shell "cmd.exe /c start " & quote(fileName) & " " & quote(fileName)
End Sub


Public Sub htmlStyle(useSmallFont As Boolean)
    html ("<STYLE type=" & quote("text/css") & ">")
    html ("<!--")
    html ("  body     { background-color:#fffff;")
    html ("           }")
    html ("  .header  { font-size:20pt;")
    html ("             font-family:Helvetica,Arial;")
    html ("             text-align:center;")
    html ("             margin-top:20pt;")
    html ("             color:#ffffff;")
    html ("             background-color:#008000;")
    html ("           }")
    html ("       H2  { font-size:14pt;")
    html ("             font-family:Helvetica,Arial;")
    html ("             text-align:left;")
    html ("             margin-top:20pt;")
    html ("             color:#000000;")
    html ("             background-color:#ffffff;")
    html ("           }")
    html ("        P  { font-size:10pt;")
    html ("             font-family:Helvetica,Arial; ")
    html ("             text-align:left;")
    html ("           }")
    html (" .summary  { font-size:11pt;")
    html ("             font-family:Helvetica,Arial; ")
    html ("             font-weight:normal;")
    html ("             margin-top:5pt;")
    html ("             margin-left:5pt;")
    html ("             vertical-align:middle;")
    html ("             background-color:#ffffff;")
    html ("             color:#000000;")
    html ("           }")
    If useSmallFont Then
      html ("     .tr1  { font-size:9pt;")
    Else
      html ("     .tr1  { font-size:11pt;")
    End If    
    html ("             font-family:Helvetica,Arial; ")
    html ("             font-weight:bold;")
    html ("             margin-top:5pt;")
    html ("             margin-left:5pt;")
    html ("             vertical-align:middle;")
    html ("             background-color:#000000;")
    html ("             color:#ffffff;")
    html ("           }")
    If useSmallFont Then
      html ("     .tro  { font-size:8pt;")
    Else
      html ("     .tro  { font-size:10pt;")
    End If    
    html ("             font-family:Helvetica,Arial; ")
    html ("             font-weight:normal;")
    html ("             margin-top:5pt;")
    html ("             margin-left:5pt;")
    html ("             vertical-align:top;")
    html ("             background-color:#d0d0d0;")
    html ("           }")
    If useSmallFont Then
      html ("     .tre  { font-size:8pt;")
    Else
      html ("     .tre  { font-size:10pt;")
    End If    
    html ("             font-family:Helvetica,Arial; ")
    html ("             font-weight:normal;")
    html ("             margin-top:5pt;")
    html ("             margin-left:5pt;")
    html ("             vertical-align:top;")
    html ("             background-color:#f0f0f0;")
    html ("           }")
    html ("    .mark  { background-color:#ffff00;")
    html ("             font-weight:600;")
    html ("           }")
    html ("     .gap  { background-color:#ffffff;")
    html ("           }")
    html ("    //-->")
    html ("    </STYLE>")
End Sub


Public Function big(s As String) As String
    big = "<FONT size=+1><B>" & s & "</B></FONT>"
End Function


Public Function mailLink(s As String) As String
    mailLink = "<A href='mailto:" & s & "'>" & s & "</A>"
End Function


Public Function mailLinkUndecorated(s As String) As String
    mailLinkUndecorated = "<A style='text-decoration:none;' href='mailto:" & s & "'>" & s & "</A>"
End Function


Public Function mark(s As String) As String
    mark = "<SPAN class=" & quote("mark") & ">" & replaceHtmlChars(s) & "</SPAN>"
End Function


Public Function markPattern(s As String, patt As String) As String 
   Dim t As String = ""
   Dim lastEnd As Integer = 1
   ' cf. http://java.sun.com/j2se/1.4.2/docs/api/java/util/regex/Pattern.html
  	Dim p As java#util#regex#Pattern = Pattern.compile(patt, Pattern.CASE_INSENSITIVE)
		Dim m As java#util#regex#Matcher = p.matcher(s)

		Do While m.find()
     If m.start() > lastEnd Then
         t = t & Mid(s, lastEnd, m.start() - lastEnd + 1)
     End If
     
     t = t & mark(Mid(s, m.start() + 1, m.end() - m.start() ))
     
     lastEnd = m.end() + 1
		Loop

   If lastEnd = 0 Then
      t = s
   ElseIf lastEnd <= Len(s) Then
      t = t & Mid(s, lastEnd)
   End If
   
   markPattern = t
End Function


Public Function replaceHtmlChars(s As String) As String
    Dim pos As Integer
    Dim posMax As Integer
    Dim t As String
    Dim c As String
    
    posMax = Len(s)
    t = ""
    For pos = 1 To posMax
        c = Mid(s, pos, 1)
        If c = "<" Then
            c = "&lt;"
        ElseIf c = ">" Then
            c = "&gt;"
        ElseIf c = "&" Then
            c = "&amp;"
        ElseIf c = "'" Then
            c = "&apos;"
        End If
        t = t & c
    Next pos
    replaceHtmlChars = t
End Function


Public Sub setVMLNamespace(namespace As String)
    ' Set the HTML namespace for VML graphics
    '
    ' @param namespace (typically something like "v")
    '
    ' @see #htmlHeader
    '
    VMLNamespace = namespace
End Sub


Public Function val2bullets(i As Integer) As String
'  convert integer 'i' to onto to five bullets; 6 = '-'
    Dim s As String
    Dim j As Integer
    
    s = "<FONT size=+1"
    
    If i = 6 Then
        s = s & ">-"
    Else
        s = s & " color=red>"
        For j = 1 To i
            s = s & "&bull; "
        Next j
    End If
    
    s = s & "</FONT>"
    
    val2bullets = s
End Function

Public Sub vml(tag As String, Optional style As String = "")
    vmlStart tag, style
    html ">>"
End Sub

Public Sub vmlEnd(tag As String)
    html "</" & VMLNamespace & ":" & tag & ">"
End Sub

Public Sub vmlLine(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, properties As String)
    vmlStart "line " & properties
    html "> from=" & quote(x1 & "," & y1)
    html "> to=" & quote(x2 & "," & y2) & " />"
End Sub

Public Sub vmlRect(left As Integer, top As Integer, width As Integer, height As Integer, _
                   fillColor As String, Optional title As String = "")

    Dim style As String
    Dim attribs As String
    
    style = "position:absolute;left:" & left _
          & ";top:" & top _
          & ";width:" & width _
          & ";height:" & height & ";"
    attribs = "fillcolor=" & quote(fillColor) _
            & " strokeweight=" & quote("0.4pt") 
    If title <> "" Then
        attribs = attribs & " title=" & quote(escapeXML(title)) 
    End If
    vmlStart "rect", style
    html "> " & attribs & " />"
End Sub

Public Sub vmlStart(tag As String, Optional style As String = "")
    If style = "" Then
        html "<" & VMLNamespace & ":" & Trim(tag)
    Else
        html "<" & VMLNamespace & ":" & Trim(tag) & " style=" & quote(style)
    End If
End Sub

Public Sub vmlText(x As Integer, y As Integer, s As String, Optional style As String = "")
    '  example for style:  style="text-align:center; font-weight:bold"
    Dim props As String
    Dim rStyle As String
    
    props = ""
    rStyle = "position:absolute;left:" & x & ";top:" & y & ";width:35;height:16;"
    
    vml "shape " & props, rStyle
    vml "textbox", style
    html s
    vmlEnd "textbox"
    vmlEnd "shape"
End Sub

'
'  end of mdlHtml
'