Text-centring subs - PhilOfPerth - 12-18-2024
I write mostly text-based programmes, and often need to change the content of one or more lines during run-time, so I wrote these two subs to make it simple to do this.
Nothing Earth-shattering, but they may be useful to someone:
Code: (Select All) ' This is a demo of two Subs I find useful in text-based progs, where lines of text need to be changed frequently
Screen _NewImage(1120, 768, 32)
Common Shared CPR
CPR = 1120 / _PrintWidth("X") ' chars per row - used for centring text (change 1120 to your NewImage width)
_ScreenMove (_DesktopWidth - 1120) / 2, 100
yellow
WP "XXX", "101213" ' clear rows 10,12,13 and print centred string on each of them
Sleep 1
WP "YYY", "11" ' clear row 11 and print centred string on it
Sleep 1
red
WP "OOO", "11" ' clear row 11 and print centred red string on it
Sleep 1
white
CP "This Text", "15" ' clear row 15 and centre text on it
Sleep 1
red
WP "Finally, this", "1011121315" ' clears row 10 to 15 and centres text on each of them
Sleep 1
WP "", "11"
Sleep 1
yellow
CP Space$(20) + "Change position with Spaces", "16" ' add spaces to change text position
CP "Left or Right" + Space$(20), "17"
Sleep
' ------------------------------------------------------------------------ THESE TWO SUBS ---------------------------------------------------
Sub WP (Txt$, RN$) ' Wipe (clear) row(s) named in RN$ (2-digit line numbers), then centre the string on each
If RN$ = "" Then GoTo Place ' if RN$ is given as empty string, jump to centring
If Len(Txt$) < 1 Then Txt$ = Space$(CPR)
For a = 1 To Len(RN$) - 1 Step 2 ' for each pair of chars in RN$ (change to Step 3 for 3-digit line numbers)
CL = Val(Mid$(RN$, a, 2)) ' line to be cleaned
Locate CL, 1: Print Space$(CPL) ' write row of spaces to the line
Place:
Ctr = Int(CPR / 2 - Len(Txt$) / 2) + 1 ' find centred start position for text string
Locate CL, Ctr
Print Txt$ ' print text string there (if string is empty, line remains cleared)
Next
End Sub
Sub CP (txt$, RN$) ' Centre and Print text
If RN$ = "" Then Exit Sub
Ctr = Int(CPR / 2 - Len(txt$) / 2) + 1
Locate Val(RN$), Ctr
Print txt$
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------------------
Sub white
Color _RGB(255, 255, 255)
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub red
Color _RGB(255, 0, 0)
End Sub
You can also use Tab(n) in lieu of the Space$(n) for positioning the text
RE: Text-centring subs - SMcNeill - 12-18-2024
https://qb64phoenix.com/forum/showthread.php?tid=71 <-- I has one of these.
RE: Text-centring subs - SierraKen - 12-18-2024
Edit: Woops, I just realized you guys were talking about non-graphical screens, oh well. People that use graphical screens can use mine.
I've been wanting one of these for awhile. So I just tried to make my own using _PRINTSTRING and it works great! I also happened to find an example one in the Wiki pages when I was looking up Width, but I like mine.
This will center the text you type from the INPUT to the center of the screen. It also asks you if you want it centered by height or not. If not, it will ask you what height pixel you wish to use.
This isn't a SUB, but you could easily make it into one if you wish to.
Code: (Select All)
'This will center text in the middle of the screen.
Dim a As Long
start:
height = 0
ht = 0
Cls
a& = _NewImage(800, 600, 32)
Screen a&
Input "Print text to center -> ", a$
Input "Do you also want it centered by height (Y/N) ", yn$
If Left$(yn$, 1) = "Y" Or Left$(yn$, 1) = "y" Then
height = 1
Else
Print "Screen height: ", _Height(a&)
Input "Type a height pixel here for text: ", ht
End If
Cls
aa = Len(a$)
bb = aa * 8
w = _Width(a&)
l = _Height(a&)
center = w / 2
halfbb = center - (bb / 2)
If height = 1 Then
_PrintString (halfbb, l / 2), a$
Else
_PrintString (halfbb, ht), a$
End If
Locate 35, 1: Input "Again (Y/N) ", ag$
If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then GoTo start:
End
|