Hello again
I went through my old projects and dug this TextBox method out. I've adapted the demo to suit text adventure genre.
They're basic TextBoxes which wrap words, align text and each have their own colours, fonts and font-styles.
They are buggy with some fonts though - stick with basic default Windows fonts for now, i.e., "Courier New"-size 12 doesn't work, "Courier"-size 12 does!?
The DATA statements are messy, I'm cleaning up a ini-type-file to work with saving/loading TextBox properties.
REM Project: Morriana
REM Created: 4/22/2010 10:07:02 AM
REM
REM ***** Main Source File *****
REM
Set Display Mode 1024, 768, 32
Sync On : Sync Rate 60
Randomize Timer()
type udtPos
x1 as integer
x2 as integer
y1 as integer
y2 as integer
endType
type udtFont
name as string
size as integer
charW as byte
charH as byte
colourFg as dword
colourBg as dword
align as integer
isOpaque as boolean
style as integer
endType
type udtTextBox
index as integer
pos as udtPos
posText as udtPos
posBorder as udtPos
font as udtFont
width as integer
height as integer
colourText as dword
colourBg as dword
colourBorder as dword
border as boolean
Bg as boolean
txt as string
charsPerLine as integer
charsTotal as integer
endtype
Dim TextBox() as udtTextBox
Global maxTextBoxes
`tbMin and tbMax will change when ENTER is pressed
Global tbMin
Global tbMax
tbMax = 2
`Initialise TextBox arrays by "loading" an ini file or something like that
`This example uses DATA statements
maxTextBoxes = tbLoadFromData()
`Main Loop
` Now just loop through the textbox array min-max index numbers
` NOTE : Input routines should go before display routines
` : so that the display updates accordingly
Do
Cls
GoSub UserInput
tbDisplayRange(tbMin, tbMax)
Sync
Loop
End
Remstart
User Input
accepts <Backspace> by using a parameter in the function Entry$(1)
On first run of code, the first 3 DATA TextBoxes are displayed (tbMin = 0, tbMax = 2)
When <Enter> is pressed, a typical text adventure scenario is shown (tbMin = 3, tbMax = 7)
Remend
UserInput:
`Check for ReturnKey BEFORE assigning ENTRY$ to a variable
if ReturnKey()
CLEAR ENTRY BUFFER
`Set tbMin and tbMax to show demo adventure text
if (tbMin <> 3)
tbMin = 3
tbMax = maxTextBoxes
endif
endif
`Set the input TextBox string based on
`the ENTRY$ buffer being empty or not
checkEntry$ = ENTRY$(1)
If checkEntry$ = ""
if (tbMin = 3) then TextBox(maxTextBoxes).txt = ">"
else
TextBox(tbMax).txt = checkEntry$
endif
Return
Rem *****************************************************************************************
Rem ******** Functions *********
Rem *****************************************************************************************
Remstart
Following functions are required for reusing in other projects
note that they are all prefixed with "tb"
Remend
Function tbCreateTextBox()
Add To Queue TextBox()
retIndex = Array Count(TextBox())
endFunction retIndex
Function tbSetFont(tbIndex, fontName$, fontSize, fontStyle, fontIsOpaque as boolean)
if (fontName$ <> "")
Set Text Font fontName$
TextBox(tbIndex).font.name = fontName$
endif
if (fontSize <> 0)
Set Text Size fontSize
TextBox(tbIndex).font.size = fontSize
endif
Select fontStyle
Case 1:
Set Text To Italic
endCase
Case 2:
Set Text To Bold
endCase
Case 3:
Set Text To BoldItalic
endCase
Case Default :
Set Text To Normal
endCase
endSelect
TextBox(tbIndex).font.style = fontStyle
TextBox(tbIndex).font.charW = Text Width("X")
TextBox(tbIndex).font.charH = Text Height("X")
TextBox(tbIndex).font.isOpaque = fontIsOpaque
`TextBox(tbIndex).font.colourFg as dword
`TextBox(tbIndex).font.colourBg as dword
endFunction
`
Function tbApplyFont(tbIndex)
if (TextBox(tbIndex).font.name <> "") then Set Text Font TextBox(tbIndex).font.name
if (TextBox(tbIndex).font.size <> 0) then Set Text Size TextBox(tbIndex).font.size
if (TextBox(tbIndex).font.isOpaque)
Set Text Opaque
else
Set Text Transparent
endif
Select TextBox(tbIndex).font.style
Case 1:
Set Text To Italic
endCase
Case 2:
Set Text To Bold
endCase
Case 3:
Set Text To BoldItalic
endCase
Case Default :
Set Text To Normal
endCase
endSelect
Ink TextBox(tbIndex).colourText, 0
endFunction
`Change TextBox Position
`NOTE : negative value parameters leave the relevant TextBox property unchanged
Function tbSetPos(tbIndex, newPosX, newPosY, alsoAdjustXY2)
if (newPosX > -1)
TextBox(tbIndex).Pos.x1 = newPosX
TextBox(tbIndex).posText.x1 = newPosX + 1
if alsoAdjustXY2
TextBox(tbIndex).Pos.x2 = newPosX + TextBox(tbIndex).Width
TextBox(tbIndex).posText.x2 = newPosX - 1
endif
endif
if (newPosY > -1)
TextBox(tbIndex).pos.y1 = newPosY
TextBox(tbIndex).posText.y1 = newPosY + 1
if alsoAdjustXY2
TextBox(tbIndex).pos.y2 = newPosY + TextBox(tbIndex).Height
TextBox(tbIndex).posText.y2 = newPosY - 1
endif
endif
endFunction
`Change TextBox Size
`NOTE : negative value parameters leave the relevant TextBox property unchanged
Function tbSetSize(tbIndex, newWidth, newHeight)
if (newWidth > -1)
TextBox(tbIndex).Width = newWidth
TextBox(tbIndex).Pos.x2 = TextBox(tbIndex).Pos.x1 + newWidth
if (TextBox(tbIndex).font.charW <= 0)
`Shouldn't really get here but just-in-case
tbApplyFont(tbIndex)
TextBox(tbIndex).font.charW = Text Width("X")
endif
TextBox(tbIndex).CharsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
endif
if (newHeight > -1)
TextBox(tbIndex).Height= newHeight
TextBox(tbIndex).Pos.y2 = TextBox(tbIndex).Pos.y1 + newHeight
endif
endFunction
`Change TextBox Colours
`NOTE : as dwords are only positive
` zero value parameters leave the relevant TextBox property unchanged
Function tbSetColours(tbIndex, newColourText as dword, newColourBg as dword, newColourBorder as dword)
if (newColourText > 0)
TextBox(tbIndex).ColourText = newColourText
endif
if (newColourBg > 0)
TextBox(tbIndex).ColourBg = newColourBg
endif
if (newColourText > 0)
TextBox(tbIndex).ColourBorder = newColourBorder
endif
endFunction
Function tbSetText(tbIndex, newText$)
TextBox(tbIndex).txt = newText$
TextBox(tbIndex).charsTotal = Len(newText$)
TextBox(tbIndex).charsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
endFunction
`Update a range of TextBoxes
Function tbDisplayRange(tbIndexMin, tbIndexMax)
for tbIndex = tbIndexMin to tbIndexMax
tbDisplay(tbIndex)
next tbIndex
endFunction
Function tbDisplay(tbIndex)
Local posX1 as integer
Local posY1 as integer
Local posX2 as integer
Local posY2 as integer
Local charW as integer
Local charH as integer
Local txtChars as integer
Local charsPerLine as integer
Local chkSpace as boolean
Local txtLocal$
local tempText$
`Store the whole textbox text in a local string
`allowing alterations not affecting the original text
txtLocal$ = TextBox(tbIndex).txt
`Use local variables for TextBox dimensions
`Can be altered for centering and multi-lines
posX1 = TextBox(tbIndex).Pos.x1
posY1 = TextBox(tbIndex).Pos.y1
posX2 = TextBox(tbIndex).Pos.x2
posY2 = TextBox(tbIndex).Pos.y2
`Draw textbox border if required
if TextBox(tbIndex).Border
Ink TextBox(tbIndex).colourBorder, 0
Line posX1, posY1, posX2, posY1
Line posX1, posY2, posX2, posY2
Line posX1, posY1, posX1, posY2
Line posX2, posY1, posX2, posY2
endif
`Fill textbox BackGround if required
if TextBox(tbIndex).Bg
Ink TextBox(tbIndex).colourBg, 0
Box posX1+1, posY1+1, posX2-1, posY2-1
endif
`Set the current TextBox font and font metrics
tbApplyFont(tbIndex)
Remstart
Okey dokey,
The following code deals with the line/s in a textbox.
<txtLocal$> initally stores the whole text but gets shortened as multiple lines are used.
<tempText$> stores the text to fit in current line.
<curCharPos> is the current character check position in current line.
<chkSpace> is a flag for the last space character in tempText$ (if one exists) .
if a space is found, tempText$ stores the characters upto where that space is (curCharPos)
otherwise, tempText$ stores the whole line (charsPerLine).
Either way, txtLocal$ now gets shortened by
removing its leftmost characters which are stored in tempText$
This process repeats until the length of txtLocal$ fits on one line.
Remend
`Set the local text line checking boundaries
txtChars = Len(txtLocal$)
if (TextBox(tbIndex).font.charW <= 0)
`Shouldn't really get here but just-in-case
TextBox(tbIndex).font.charW = Text Width("X")
endif
charsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
`while there's text left in the tepText buffer, show it.
while (txtChars > 0)
`Get text that fills one line
tempText$ = Left$(txtLocal$, charsPerLine)
`Check if word wrapping is needed
if (txtChars > charsPerLine)
curCharPos = Len(tempText$) + 1
Repeat
dec curCharPos
chkSpace = (" " = mid$(tempText$, curCharPos))
Until (curCharPos = 1) or (chkSpace)
endif
`Check where and if last space was found
if (chkSpace)
`store the line text that fits upto last space in line
tempText$ = Left$(txtLocal$, curCharPos)
`strip the local text upto last space in line
txtLocal$ = Right$(txtLocal$, txtChars - curCharPos)
chkSpace = 0
else
`no space found in line so just show tempText$ as it is
`strip the local text upto characters that fit in line
txtLocal$ = Right$(txtLocal$, txtChars - charsPerLine)
endif
`Display and align the "wrapped" text
Select TextBox(tbIndex).font.align
Case 0 :
`Centered
posX1 = TextBox(tbIndex).Pos.x1 + (TextBox(tbIndex).Width / 2)
Center Text posX1, posY1, tempText$
endCase
Case 1 :
`Right align
posX1 = TextBox(tbIndex).Pos.x2 - Text Width(tempText$) - 1
Text posX1, posY1, tempText$
endCase
Case Default :
`Left align
posX1 = TextBox(tbIndex).Pos.x1 + 1
Text posX1, posY1, tempText$
endCase
endSelect
`Set display cursor to next line
Inc posY1, TextBox(tbIndex).font.charH
`Get the new length of the stripped local text
`if a single line is passed, txtChars = 0
txtChars = Len(txtLocal$)
endWhile
endFunction
Remstart
Following code is for this example snippet only
not required for using the Textbox functions in other projects
Remend
`the HexString to Dword conversion function
`processes just the last 8 chars of ANY string passed
`!!! valid Hex chars [numerics 0-9 and "ABCDEF" or "abcdef"]
`!!! INCORRECT = HexStrToDW("0xFF")
`!!! CORRECT = HexStrToDW("FF")
Function HexStrToDW(pStrHex as string)
Local MinLen as integer
Local MaxLen as integer
Local chPos as integer
Local chAsc as byte
Local chVal as dword
Local retDW as dword
Local bitShift as dword = 1
`The highest 32-bit Dword hex string is 8 chars "FfFfFfFf"
MaxLen = Len(pStrHex)
if MaxLen > 8 then MinLen = MaxLen - 8
`Loop from end of string to first hex-char
`i.e. 0x321 becomes 123 = 1*1 + 2*16 + 3*256, etc
`otherwise the starting power of 16 would also need to be calculated
`based on length of hex string
for chPos = MaxLen to MinLen Step -1
`Get current char
ch$ = Mid$(pStrHex, chPos)
`Pointless multiplying by zero
if (ch$ <> "0")
`Get the char ASCII code value
chAsc = Asc(ch$)
`Keep masked bits representing 0-15
chVal = (chAsc && 0xf)
`Check if hex-char is a letter of any case
`Bytes (i.e. letters) masked with 64 need 9 added to their masked value
if (chAsc && 0x40) then chVal = chVal + 9
`Increment the dword by current power of 16 multiplied with current hex-char value
retDW = retDW + (bitShift * chVal)
endif
`Left-shift bits to the next power of 16
bitShift = bitShift << 4
next chPos
EndFunction retDW
` Use data statements to initialise TextBox array
` DATA statements located at end of snippet
Function tbLoadFromData()
Restore iniTextBox
`Check if first posX = ROGUE -999 value
Read posX1
`-999 is a ROGUE value which terminates the data reading sequence
While (posX1 <> -999)
tbCurrentIndex = tbCreateTextBox()
TextBox().index = tbCurrentIndex
Read posY1
Read width
Read height
Read tempColourFg$
Read tempColourBg$
Read tempColourBorder$
Read TextBox().border
Read TextBox().Bg
Read tempFontName$
Read tempFontSize
Read TextBox().font.Align
Read tempStyle
Read tempOpaque
Read tempText$
`NOTE : the order of functions is important
` : they depend on preset values in TextBox UDT
tbSetFont(tbCurrentIndex, tempFontName$, tempFontSize, tempStyle, tempOpaque)
tbSetPos(tbCurrentIndex, posX1, posY1, 0)
tbSetSize(tbCurrentIndex, width, height)
tbSetText(tbCurrentIndex, tempText$)
tbSetColours(tbCurrentIndex, HexStrToDW(tempColourFg$), HexStrToDW(tempColourBg$), HexStrToDW(tempColourBorder$))
`Read next checkposX
Read posX1
endWhile
endFunction tbCurrentIndex
`The data statements for the textbox array
`DATALINE-1 posX1, posY1, width, height
`DATALINE-2 colourFg, colourBg, colorBorder, flag Border , flag Background coloured
`DATALINE-3 Font Name, Font Size, Text Alignment, Text Style, Text Opacity
`DATALINE-4 TextBox string
`Alignment : -1 = Left, 0 = Centered, 1 = Right
`Style : 0 = normal, 1 = italic, 2 = bold, 3 = bold italic
iniTextBox:
DATA 70, 50, 320, 240
DATA "ff00FFff", "ff200000", "ffFFff00", 1, 0
DATA "Arial", 14, 1, 0, 0
DATA "TextBox1 with one line and only a border"
DATA 410, 50, 320, 240
DATA "ffFFff00", "ff002000", "ffFF00FF", 0, 1
DATA "Courier", 14, -1, 1, 0
DATA "TextBox 2 with no border and a coloured background. this text is so wide that when it tries to fit in TextBox2, it get's wrapped around. Notice that the text cleanly wraps around. There is no checking for too many lines fitting in textbox height or whether the text exceeds the textbox dimensions."
DATA 240, 300, 400, 30
DATA "ff00FF00", "ff000020", "ff00FFFF", 1, 1
DATA "Verdana", 14, 0, 0, 0
DATA "Typing Text Box has background and border - typing wraps around - backspace works - try it!"
DATA 10, 1, 640, 24
DATA "ff00FF00", "ff100010", "ffFFff00", 1, 1
DATA "Lucida Console", 16, 0, 2, 0
DATA "A Rank Dungeon, North Corridor"
DATA 10, 30, 640, 240
DATA "ffFFff00", "ff000010", "ffFF00FF", 0, 1
DATA "courier", 12, -1, 0, 0
DATA "You notice a foul stench as you enter the room and the source soon becomes apparent.Scanning your surroundings you notice an old, decaying, corpse. It is dressed in the uniform of The King's Old Guard."
DATA 10, 274, 640, 32
DATA "ff00FFff", "ff100000", "ff00ffFF", 1, 1
DATA "Arial", 16, 0, 2, 0
DATA "You also see: an oak door, a nest of spiders"
DATA 10, 312, 640, 32
DATA "ffFF00FF", "ff001000", "ffFFff00", 1, 1
DATA "Verdana", 16, 0, 1, 0
DATA "Obvious Exits: South, East, Northwest"
DATA 10, 348, 640, 16,
DATA "ffFFffFF", "ff000010", "ff00FFFF", 1, 1
DATA "Courier", 16, -1, 0, 0
DATA ">"
DATA -999
I'll explain anything my comments left out but for now,
The Heroes Finale is on so I'm off for a bit.
All the best.
***** EDIT *****
This snippet is a cleaner and improved version of just the TextBox functions. Some of the functions have been altered to the previous snippet but are more stable and user friendly
`Project: TextBoxes
`When multiple textboxes change the current font,
`any TextBoxes with fontName = "" will use the last font set
`Assigning a global default font ensures more stable results
#constant TB_FONT_NAME_DEF "System"
#constant TB_FONT_SIZE_DEF 12
`Constants for some TextBox Function Parameters
#constant TB_BORDER_OFF 0
#constant TB_BORDER_ON 1
#constant TB_BORDER_LEAVE -1
#constant TB_BACKGROUND_OFF 0
#constant TB_BACKGROUND_ON 1
#constant TB_BACKGROUND_LEAVE -1
#constant TB_ADJUST_XY2_OFF 0
#constant TB_ADJUST_XY2_ON 1
#constant TB_FONT_ALIGN_LEFT 0
#constant TB_FONT_ALIGN_CENTER 1
#constant TB_FONT_ALIGN_RIGHT 2
`NOTE : TB_FONT_STYLE constants are not exclusive to TextBox functions
`they are the same values as the DBPro <Text Style()> function results
#constant TB_FONT_STYLE_NORMAL 0
#constant TB_FONT_STYLE_ITALIC 1
#constant TB_FONT_STYLE_BOLD 2
#constant TB_FONT_STYLE_BOLDITALIC 3
#constant TB_FONT_TRANSPARENT_ON 0
#constant TB_FONT_TRANSPARENT_OFF 1
#constant TB_FONT_OPAQUE_OFF 0
#constant TB_FONT_OPAQUE_ON 1
#constant TB_LEAVE -1
`NOTE : I've just put these in to show what parameters TB_LEAVE affects
#constant TB_FONT_NAME_LEAVE "-1"
#constant TB_FONT_SIZE_LEAVE -1
#constant TB_FONT_STYLE_LEAVE -1
#constant TB_FONT_ALIGN_LEAVE -1
#constant TB_FONT_OPAQUE_LEAVE -1
#constant TB_FONT_TRANSPARENT_LEAVE -1
type udtPos
x1 as integer
x2 as integer
y1 as integer
y2 as integer
endType
type udtFont
name as string
size as integer
charW as byte
charH as byte
colourFg as dword
colourBg as dword
align as integer
isOpaque as boolean
style as integer
endType
type udtTextBox
index as integer
pos as udtPos
posText as udtPos
posBorder as udtPos
font as udtFont
width as integer
height as integer
colourText as dword
colourBg as dword
colourBorder as dword
border as boolean
Bg as boolean
txt as string
charsPerLine as integer
charsTotal as integer
endtype
Dim TextBox() as udtTextBox
Global maxTextBoxes
`tbMin and tbMax used to loop through a specific range
Global tbMin
Global tbMax
`The current TextBox being created and initialised
Global tbCurrentIndex
`The user input TextBox index
Global tbInputBox
`Init
Set Display Mode 1024, 768, 32
Set Window On
Sync On : Sync Rate 60
Randomize Timer()
maxTextBoxes = SetupDemoBoxes()
tbMax = maxTextBoxes
`Main Loop
Do
Cls
retInput = UserInput()
tbDisplayRange(tbMin, tbMax)
Sync
Loop
End
Rem *****************************************************************************************
Rem ******** Functions *********
Rem *****************************************************************************************
Remstart
User Input
accepts <Backspace> by using a parameter in the function Entry$(1)
On first run of code, the first 3 DATA TextBoxes are displayed (tbMin = 0, tbMax = 2)
When <Enter> is pressed, a typical text adventure scenario is shown (tbMin = 3, tbMax = 7)
Remend
Function UserInput()
`Check for ReturnKey BEFORE assigning ENTRY$ to a variable
if ReturnKey()
CLEAR ENTRY BUFFER
endif
`Set the input TextBox string based on
`the ENTRY$ buffer being empty or not
checkEntry$ = ENTRY$(1)
If checkEntry$ = ""
TextBox(tbInputBox).txt = ">" + Str$(Text Width("X"))
else
TextBox(tbInputBox).txt = checkEntry$
endif
`This will be set to whatever action flag is required at a later date
retVal = 0
endFunction retVal
Function SetupDemoBoxes()
`Just a simple demo of how to create and use the TextBox functions
width = 640
height = 320
`Set the TextBox Window to be Centered
posX1 = (Screen Width() - width) / 2
posY1 = (Screen Height() - height) / 2
tempText$ = "TextBox 1 - there's a lot of things that need doing with these functions, but all in all they should be enough for anyone to get started. "
tempText$ = tempText$ + "Also, there's a lot of room for improvement but my coding techniques are rustier than a rusty object that is very rusty ... and that's rusty! "
tempText$ = tempText$ + "Anyhow, future ammendments will be using a data-file to load and store textbox properties, a proper user-input box, "
tempText$ = tempText$ + "scrolling or history, similar the TDK example, Mouse-Interaction and other stuff that comes up as I go along. "
tempText$ = tempText$ + "Oh-Aye! Parsing of new-line-breaks, /nl <BR> CRLF sort-of-thing. There we go, this text is long enough to show wrapping :) "
tbCurrentIndex = tbCreateTextBox()
`NOTE : Always set the font first as this sets variables for word-wrapping, alignment, etc.
tbSetFont(tbCurrentIndex, "Courier", 18, TB_FONT_STYLE_BOLD, TB_FONT_ALIGN_LEFT, TB_FONT_TRANSPARENT_ON)
tbSetPos(tbCurrentIndex, posX1, posY1, TB_ADJUST_XY2_OFF)
tbSetSize(tbCurrentIndex, width, height)
tbSetText(tbCurrentIndex, tempText$)
tbSetColours(tbCurrentIndex, 0xFFffFF00, 0xFF002100, 0xFF00FFff)
tbSetFlags(tbCurrentIndex, TB_BORDER_ON, TB_BACKGROUND_ON)
`Input TextBox
width = Screen Width() - 20
height = 40
posX1 = 0
posY1 = TextBox(0).pos.y2 + 8
tempText$ = "User Input >"
tbCurrentIndex = tbCreateTextBox()
`NOTE : Always set the font first as this sets variables for word-wrapping, alignment, etc.
tbSetFont(tbCurrentIndex, "Courier", 18, TB_FONT_STYLE_NORMAL, TB_FONT_ALIGN_LEFT, TB_FONT_TRANSPARENT_ON)
tbSetPos(tbCurrentIndex, posX1, posY1, TB_ADJUST_XY2_OFF)
tbSetSize(tbCurrentIndex, width, height)
tbSetText(tbCurrentIndex, tempText$)
tbSetColours(tbCurrentIndex, 0xFF001100, 0xFF0080FF, 0xFFff00ff)
tbSetFlags(tbCurrentIndex, TB_BORDER_OFF, TB_BACKGROUND_ON)
`NOTE : here the input box index number has been assigned
tbInputBox = tbCurrentIndex
`Left TextBox
width = TextBox(0).pos.x1 - 5
height = 420
`Set the TextBox Window to be Centered
posX1 = 0
posY1 = 0
tempText$ = "TextBox 2 - if you notice this notice then you may notice that this notice is a notice not worth noticing at all"
tbCurrentIndex = tbCreateTextBox()
`NOTE : Always set the font first as this sets variables for word-wrapping, alignment, etc.
tbSetFont(tbCurrentIndex, "Lucida Console", 18, TB_FONT_STYLE_NORMAL, TB_FONT_ALIGN_CENTER, TB_FONT_TRANSPARENT_ON)
tbSetPos(tbCurrentIndex, posX1, posY1, TB_ADJUST_XY2_OFF)
tbSetSize(tbCurrentIndex, width, height)
tbSetText(tbCurrentIndex, tempText$)
tbSetColours(tbCurrentIndex, 0xFF00FF00, 0xFF000030, 0xFFff00ff)
tbSetFlags(tbCurrentIndex, TB_BORDER_ON, TB_BACKGROUND_ON)
`Right TextBox
width = Screen Width() - TextBox(0).pos.x2 - 15
height = 240
posX1 = TextBox(0).pos.x2 + 5
posY1 = 0
tempText$ = "TextBox 3"
tbCurrentIndex = tbCreateTextBox()
`NOTE : Always set the font first as this sets variables for word-wrapping, alignment, etc.
tbSetFont(tbCurrentIndex, "arial", 18, TB_FONT_STYLE_BOLDITALIC, TB_FONT_ALIGN_RIGHT, TB_FONT_TRANSPARENT_ON)
tbSetPos(tbCurrentIndex, posX1, posY1, TB_ADJUST_XY2_OFF)
tbSetSize(tbCurrentIndex, width, height)
tbSetText(tbCurrentIndex, tempText$)
tbSetColours(tbCurrentIndex, 0xFF001100, 0xFF0080FF, 0xFFff00ff)
tbSetFlags(tbCurrentIndex, TB_BORDER_OFF, TB_BACKGROUND_ON)
endFunction tbCurrentIndex
Remstart
Following functions are required for reusing in other projects
note that they are all prefixed with "tb"
Remend
Function tbCreateTextBox()
Add To Queue TextBox()
retIndex = Array Count(TextBox())
endFunction retIndex
`Change TextBox Font
Function tbSetFont(tbIndex, fontName$, fontSize, fontStyle, fontAlign, fontIsOpaque as boolean)
if (Val(fontName$) <> TB_LEAVE)
if (fontName$ = TB_FONT_NAME_DEF)
Set Text Font TB_FONT_NAME_DEF
TextBox(tbIndex).font.name = TB_FONT_NAME_DEF
else
Set Text Font fontName$
TextBox(tbIndex).font.name = fontName$
endif
endif
if (fontSize <> TB_LEAVE)
if (fontSize > 0)
Set Text Size fontSize
TextBox(tbIndex).font.size = fontSize
else
Set Text Size TB_FONT_SIZE_DEF
TextBox(tbIndex).font.size = TB_FONT_SIZE_DEF
endif
endif
if (fontStyle <> TB_LEAVE)
Select fontStyle
Case 1:
Set Text To Italic
endCase
Case 2:
Set Text To Bold
endCase
Case 3:
Set Text To BoldItalic
endCase
Case Default :
Set Text To Normal
endCase
endSelect
TextBox(tbIndex).font.style = fontStyle
endif
TextBox(tbIndex).font.align = fontAlign
TextBox(tbIndex).font.isOpaque = fontIsOpaque
TextBox(tbIndex).font.charW = Text Width("X")
TextBox(tbIndex).font.charH = Text Height("X")
`TextBox(tbIndex).font.colourFg as dword
`TextBox(tbIndex).font.colourBg as dword
endFunction
`Change TextBox Position
`NOTE : negative value parameters leave the relevant TextBox property unchanged
` alsoAdjustXY2 allows the function to reset the width and height
` without the need to call tbSetSize after
Function tbSetPos(tbIndex, newPosX, newPosY, alsoAdjustXY2)
if (newPosX > TB_LEAVE)
TextBox(tbIndex).Pos.x1 = newPosX
TextBox(tbIndex).posText.x1 = newPosX + 1
if alsoAdjustXY2
TextBox(tbIndex).Pos.x2 = newPosX + TextBox(tbIndex).Width
TextBox(tbIndex).posText.x2 = newPosX - 1
endif
endif
if (newPosY > TB_LEAVE)
TextBox(tbIndex).pos.y1 = newPosY
TextBox(tbIndex).posText.y1 = newPosY + 1
if alsoAdjustXY2
TextBox(tbIndex).pos.y2 = newPosY + TextBox(tbIndex).Height
TextBox(tbIndex).posText.y2 = newPosY - 1
endif
endif
endFunction
`Change TextBox Size
`NOTE : negative value parameters leave the relevant TextBox property unchanged
Function tbSetSize(tbIndex, newWidth, newHeight)
if (newWidth > TB_LEAVE)
TextBox(tbIndex).Width = newWidth
TextBox(tbIndex).Pos.x2 = TextBox(tbIndex).Pos.x1 + newWidth
if (TextBox(tbIndex).font.charW <= 0)
`Shouldn't really get here but just-in-case
tbApplyFont(tbIndex)
TextBox(tbIndex).font.charW = Text Width("X")
endif
TextBox(tbIndex).CharsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
endif
if (newHeight > TB_LEAVE)
TextBox(tbIndex).Height= newHeight
TextBox(tbIndex).Pos.y2 = TextBox(tbIndex).Pos.y1 + newHeight
endif
endFunction
`Change TextBox Colours
`NOTE : as dwords are only positive
` zero value parameters leave the relevant TextBox property unchanged
Function tbSetColours(tbIndex, newColourText as dword, newColourBg as dword, newColourBorder as dword)
if (newColourText > 0)
TextBox(tbIndex).ColourText = newColourText
endif
if (newColourBg > 0)
TextBox(tbIndex).ColourBg = newColourBg
endif
if (newColourText > 0)
TextBox(tbIndex).ColourBorder = newColourBorder
endif
endFunction
`Change TextBox Border and Background Flags
`NOTE : negative value parameters leave the relevant TextBox property unchanged
Function tbSetFlags(tbIndex, BorderIsOn, BackgroundIsOn)
if (BorderIsOn > TB_LEAVE) then TextBox(tbIndex).border = BorderIsOn
if (BackgroundIsOn > TB_LEAVE) then TextBox(tbIndex).Bg = BackgroundIsOn
endFunction
`Set the TextBox display string
Function tbSetText(tbIndex, newText$)
TextBox(tbIndex).txt = newText$
TextBox(tbIndex).charsTotal = Len(newText$)
if (TextBox(tbIndex).font.charW <= 0)
`Shouldn't really get here but just-in-case
tbApplyFont(tbIndex)
TextBox(tbIndex).font.charW = Text Width("X")
endif
TextBox(tbIndex).charsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
endFunction
`Apply TextBox font styles
Function tbApplyFont(tbIndex)
`As a global default font is used,
`there's no need to check if font was used
Set Text Font TextBox(tbIndex).font.name
Set Text Size TextBox(tbIndex).font.size
if (TextBox(tbIndex).font.isOpaque)
Set Text Opaque
else
Set Text Transparent
endif
Select TextBox(tbIndex).font.style
Case 1:
Set Text To Italic
endCase
Case 2:
Set Text To Bold
endCase
Case 3:
Set Text To BoldItalic
endCase
Case Default :
Set Text To Normal
endCase
endSelect
Ink TextBox(tbIndex).colourText, 0
endFunction
`Display a range of TextBoxes
Function tbDisplayRange(tbIndexMin, tbIndexMax)
for tbIndex = tbIndexMin to tbIndexMax
tbDisplay(tbIndex)
next tbIndex
endFunction
`Display one TextBox
Function tbDisplay(tbIndex)
Local posX1 as integer
Local posY1 as integer
Local posX2 as integer
Local posY2 as integer
Local charW as integer
Local charH as integer
Local txtChars as integer
Local charsPerLine as integer
Local chkSpace as boolean
Local txtLocal$
local tempText$
`Store the whole textbox text in a local string
`allowing alterations not affecting the original text
txtLocal$ = TextBox(tbIndex).txt
`Use local variables for TextBox dimensions
`Can be altered for centering and multi-lines
posX1 = TextBox(tbIndex).Pos.x1
posY1 = TextBox(tbIndex).Pos.y1
posX2 = TextBox(tbIndex).Pos.x2
posY2 = TextBox(tbIndex).Pos.y2
`Draw textbox border if required
if TextBox(tbIndex).Border
Ink TextBox(tbIndex).colourBorder, 0
Line posX1, posY1, posX2, posY1
Line posX1, posY2, posX2, posY2
Line posX1, posY1, posX1, posY2
Line posX2, posY1, posX2, posY2
endif
`Fill TextBox BackGround if required
Inc posX1
Inc posY1
Dec posX2
Dec posY2
if TextBox(tbIndex).Bg
Ink TextBox(tbIndex).colourBg, 0
Box posX1, posY1, posX2, posY2
endif
`Set the current TextBox font and font metrics
tbApplyFont(tbIndex)
Remstart
Okey dokey,
The following code deals with the line/s in a textbox.
<txtLocal$> initally stores the whole text but gets shortened as multiple lines are used.
<tempText$> stores the text to fit in current line.
<curCharPos> is the current character check position in current line.
<chkSpace> is a flag for the last space character in tempText$ (if one exists) .
if a space is found, tempText$ stores the characters upto where that space is (curCharPos)
otherwise, tempText$ stores the whole line (charsPerLine).
Either way, txtLocal$ now gets shortened by
removing its leftmost characters which are stored in tempText$
This process repeats until the length of txtLocal$ fits on one line.
Remend
`Set the local text line checking boundaries
txtChars = Len(txtLocal$)
if (TextBox(tbIndex).font.charW <= 0)
`Shouldn't really get here but just-in-case
TextBox(tbIndex).font.charW = Text Width("X")
endif
charsPerLine = TextBox(tbIndex).Width / TextBox(tbIndex).font.charW
`while there's text left in the tempText buffer, show it.
while (txtChars > 0)
`Get text that fills one line
tempText$ = Left$(txtLocal$, charsPerLine)
`Check if word wrapping is needed
if (txtChars > charsPerLine)
curCharPos = Len(tempText$) + 1
Repeat
dec curCharPos
chkSpace = (" " = mid$(tempText$, curCharPos))
Until (curCharPos = 1) or (chkSpace)
endif
`Check where and if last space was found
if (chkSpace)
`store the line text that fits upto last space in line
tempText$ = Left$(txtLocal$, curCharPos)
`strip the local text upto last space in line
txtLocal$ = Right$(txtLocal$, txtChars - curCharPos)
chkSpace = 0
else
`no space found in line so just show tempText$ as it is
`strip the local text upto characters that fit in line
txtLocal$ = Right$(txtLocal$, txtChars - charsPerLine)
endif
`Display and align the "wrapped" text
Select TextBox(tbIndex).font.align
Case TB_FONT_ALIGN_CENTER :
`Centered
posX1 = TextBox(tbIndex).Pos.x1 + (TextBox(tbIndex).Width / 2)
Center Text posX1, posY1, tempText$
endCase
Case TB_FONT_ALIGN_RIGHT :
`Right align
posX1 = TextBox(tbIndex).Pos.x2 - Text Width(tempText$) - 1
Text posX1, posY1, tempText$
endCase
Case Default :
`Left align
`Case Default is used as a precaution
posX1 = TextBox(tbIndex).Pos.x1 + 1
Text posX1, posY1, tempText$
endCase
endSelect
`Set display cursor to next line
Inc posY1, TextBox(tbIndex).font.charH
`Get the new length of the stripped local text
`if a single line is passed, txtChars = 0
txtChars = Len(txtLocal$)
endWhile
endFunction
All The Best