Code-a-holic: textarea

Wednesday, September 07, 2005
[VBScript/HTA] More Broggle

The next version of Broggle with the readonly textarea for the code.
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<HTA:APPLICATION id=oHTA
scroll="yes" showInTaskBar="yes" caption="yes" applicationName="Broggle"
CONTEXTMENU="yes" SYSMENU="yes" singleInstance="yes" maximizeButton="no">
<SCRIPT language=VBScript>
ResizeTo 631,500


Dim lastMark
Dim inCode


Function stopMarkup( mark )
    Dim res
    Select Case mark
    Case "code"
        res = "</textarea>"
        inCode = False
    Case "quot"
        res = "</blockquote>"
    Case "text"
        res = "</span>"
    case "end"
        res = ""
    End Select
    stopMarkup = res
End Function


Function startMarkup( mark )
    Dim res
    res = stopMarkup( lastMark )
    Select Case mark
    Case "code"
        res = res & "<textarea cols=""60"" rows=""20"" style=""width: 100%; height: 500px;"" wrap=""off"" readonly>"
        inCode = True
    Case "quot"
        res = res & "<blockquote>"
    Case "text"
        res = res & "<span style=""font-family: georgia;"">"
    case "end"
        res = res & ""
    End Select
    startMarkup = res
End Function


Sub Evaluate( theText )
  Dim theList, theMax, i, theLine
  Dim theResult
  Dim theTemp
  Dim markup


  theResult = ""
  theList = Split( theText, vbCRLF )
  theMax = UBound( theList )
  lastMark = ""
  inCode = False
  For i = 0 to theMax
    theLine = theList( i )


    If Left( theLine, 1 ) = "#" Then
        markup = Mid( theLine, 2 )
        TheResult = theResult & startMarkup( markup )
        lastMark = markup
    Else
        If theLine = "" And InCode = False Then
            theResult = theResult & "<BR><BR>"
        Else
          If inCode = True Then
            theTemp = theLine
            If theTemp = "" Then
'                theTemp = "<BR><BR>"
                theTemp = vbCrLf
            Else
                theTemp = Replace( theTemp, "&", "&amp;" )
                theTemp = Replace( theTemp, "<", "&lt;" )
                theTemp = Replace( theTemp, ">", "&gt;" )
            End If
            theResult = theResult & theTemp & vbCRLF
          Else
            theResult = theResult & theLine & vbCRLF
          End If
        End If
    End If


    'MsgBox theResult
  Next
  if lastMark <> "end" Then theResult = theResult & stopMarkup( lastMark )
  tSlave.value = theResult
End Sub


Sub bEvaluate_Click()
  if tMaster.value = "" Then
    MsgBox "Can't evaluate nothing",,"Broggle"
  Else
    Evaluate tMaster.value
  End If
End Sub


Sub bCopy_Click()
  if tSlave.Value = "" Then
    MsgBox "Can't copy nothing.",,"Broggle"
  Else
    document.parentwindow.clipboardData.SetData "text", tSlave.Value
  End If
End Sub


Sub bPreview_Click
    If tSlave.Value <> "" Then
        preview.innerHTML = tSlave.Value
    End If
End Sub


Sub bScreen_Click
  v3.Value = document.body.clientHeight
  v4.Value = document.body.clientWidth


End Sub
</SCRIPT>
</HEAD>
<BODY>
<P><TEXTAREA id=tMaster style="WIDTH: 578px; HEIGHT: 130px" name=tMaster rows=6 cols=61></TEXTAREA>&nbsp;</P>
<P><TEXTAREA id=tSlave style="WIDTH: 579px; HEIGHT: 166px" name=tSlave rows=8 cols=62></TEXTAREA>&nbsp;</P>
<P><INPUT id=bEvaluate onclick=bEvaluate_Click type=button value=Convert name=bEvaluate>&nbsp;
<INPUT id="bPreview" onclick="bPreview_Click" type=button value="Preview">&nbsp;
<INPUT id=bCopy onclick=bCopy_Click type=button value="Copy to Clipboard"></P>
<HR>
<DIV id="preview"></DIV>
</BODY></HTML>