[bb] TextArea Html Formatting by Todd [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:43

Previous topic - Next topic

BlitzBot

Title : TextArea Html Formatting
Author : Todd
Posted : 1+ years ago

Description : Basically all this is, is an easier way to format a TextArea gadget with color, bold, etc. There is just one command: FormatTextArea(). This will do all of the formatting for you! The tags that are supported right now are: <b>Bold</b> <i>Italic</i> and [c:HEXCOLOR]Color[/c:000000]. They can be combinded for more than one style, they work just like html tags. Here's a little example to get you started:

Include "TextAreaTags.bb"

MainWnd=CreateWindow("TextArea Formatting",0,0,500,350)
WndW=ClientWidth(MainWnd)
WndH=ClientHeight(MainWnd)
SetMinWindowSize MainWnd

TextArea=CreateTextArea(4,4,WndW-8,WndH-8,MainWnd)
SetGadgetFont TextArea,LoadFont("Verdana",15)
SetGadgetLayout TextArea,1,1,1,1

FormatTextArea(TextArea,"Examples: ",TxAppendText)
FormatTextArea(TextArea,"<b>Bold</b>, ",TxAppendText)
FormatTextArea(TextArea,"<i>Italic</i>, ",TxAppendText)
FormatTextArea(TextArea,"<i><b>Bold & Italic</b></i>, ",TxAppendText)
FormatTextArea(TextArea,"[c:0000FF]<b>Color!</b>[/c:0000FF]",TxAppendText)

While WaitEvent() <> $803
Wend


(TextAreaTags.bb): [/i]

Code :
Code (blitzbasic) Select
;TextArea Html-Style Tags
;Written by Todd Yandell

Type TxTag
Field Flags,Val$
Field Red,Grn,Blu
Field Pos,Size
End Type

Const TxFormatOnly=0
Const TxSetText=1
Const TxAppendText=2

Global StTags$[16],TagDef$[16],TgClose$="/"
Global TagOpen$="[",TagClose$="]"
Global MaxTags=3,DefTextRed,DefTextGrn,DefTextBlu

StTags[1]="b":TagDef[1]="Bold"
StTags[2]="i":TagDef[2]="Italic"
StTags[3]="c:%%%%%%":TagDef[3]="Color"

Function FormatTextArea(TextArea,StText$,TextMode=0)
LockTextArea TextArea
If StText$ <> ""
Local Buffer$,TagMode,Char$,Ch,CharA$,CharB$,CloseMode
Local NewTag$,ChTag$,Match,Tag,Pos,TextFlags,NewLine$
Local TextRed,TextGrn,TextBlu,NewTagMode,NewCol$,StartPos
Nt.TxTag=New TxTag
NtPos=0
If TextMode=2
NtPos=TextAreaLen(TextArea,1)
StartPos=NtPos
EndIf
For Ch=1 To Len(StText$)
Char$=Mid(StText$,Ch,1)
If Char=TagOpen
If TagMode=False
TagMode=True
Buffer=""
EndIf
ElseIf Char=TagClose
If TagMode=True
TagMode=False
NewTag=Replace(Buffer,TgClose,"")
CloseMode=False
If NewTag <> Buffer
CloseMode=True
EndIf
Match=False
For Tag=1 To MaxTags
ChTag=StTags[Tag]
If Len(ChTag)=Len(NewTag)
For Pos=1 To Len(ChTag)
CharA=Mid(ChTag,Pos,1)
CharB=Mid(NewTag,Pos,1)
If CharA <> "%"
If CharA <> CharB
Exit
EndIf
EndIf
Next
If Pos=Len(ChTag)+1
Match=True
Exit
Else
Match=False
EndIf
EndIf
Next
If Match=True
Select TagDef[Tag]
Case "Bold"
If Not CloseMode
TextFlags=TextFlags Or 1
Else
TextFlags=TextFlags Xor 1
EndIf
Case "Italic"
If Not CloseMode
TextFlags=TextFlags Or 2
Else
TextFlags=TextFlags Xor 2
EndIf
Case "Color"
If Not CloseMode
If Instr(NewTag,":")
ClPos=Instr(NewTag,":")
NewCol=Right(NewTag,Len(NewTag)-ClPos)
TextRed=Hex2Int(Mid(NewCol,1,2))
TextGrn=Hex2Int(Mid(NewCol,3,2))
TextBlu=Hex2Int(Mid(NewCol,5,2))
EndIf
Else
TextRed=DefTextRed
TextGrn=DefTextGrn
TextBlu=DefTextBlu
EndIf
End Select
Nt=New TxTag
NtPos=StartPos+Ch2
NtFlags=TextFlags
NtRed=TextRed
NtGrn=TextGrn
NtBlu=TextBlu
EndIf
Buffer=""
EndIf
Else
Buffer=Buffer+Char
If Not TagMode
Ch2=Ch2+1
NtSize=NtSize+1
NtVal=Buffer
EndIf
EndIf
Next
For Nt.TxTag=Each TxTag
If NtVal=""
Delete Nt
EndIf
Next
Select TextMode
Case 1
SetTextAreaText TextArea,""
For Nt.TxTag=Each TxTag
AddTextAreaText TextArea,NtVal
Next
Case 2
For Nt.TxTag=Each TxTag
AddTextAreaText TextArea,NtVal
Next
End Select
For Nt.TxTag=Each TxTag
FormatTextAreaText(TextArea,NtRed,NtGrn,NtBlu,NtFlags,NtPos,NtSize)
Next
Delete Each TxTag
EndIf
UnlockTextArea TextArea
End Function

Function Hex2Int(val$)
For x=0 To Len(val$)-1
ch$=Mid(val,x+1,1)
Select Upper(ch)
Case 0,1,2,3,4,5,6,7,8,9
chn=Int(ch)
Case "A"
chn=10
Case "B"
chn=11
Case "C"
chn=12
Case "D"
chn=13
Case "E"
chn=14
Case "F"
chn=15
Default
Return -1
End Select
vv=vv+(chn*(16^(Len(val$)-(x+1))))
Next
Return vv
End Function


Comments : none...