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

BlitzBot · June 29, 2017, 00:28:43

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:

Code: BASIC

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

Code: BASIC

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

;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...

SyntaxBomb - Indie Coders

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

BlitzBot