+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Text Effects 2 (/showthread.php?tid=4054)
Text Effects 2 - 2112 - 10-29-2025
Code: (Select All)
handle& = _NewImage(1050, 800, 32)
Screen handle&
Dim Shared Lw, Lh As Integer
Lw = 8: Lh = 16
Dim Shared Letter(255, Lw + 1, Lh + 1) As Integer
Cls , _RGB(0, 0, 0)
Color _RGB(1, 1, 1), _RGB(0, 0, 0)
For ch = 1 To 255 '----------LOAD CHARACTERS TO ARRAY
_PrintString (0, 0), Chr$(ch)
For i = 0 To Lw
For k = 0 To Lh
Letter(ch, i + 1, k + 1) = 0: If Point(i, k) = _RGB(1, 1, 1) Then Letter(ch, i + 1, k + 1) = 1
Next k
Next i
Next ch
'----------------------EXAMPLES------------------------
Cls , _RGB(0, 0, 0)
Color _RGB(200, 200, 200), _RGB(0, 0, 220)
c1 = 0
For i1 = 1 To 10
For k1 = 1 To 26
c1 = c1 + 1
_PrintString (k1 * 40 - 34, i1 * 80 - 80), LTrim$(Str$(c1)) + Chr$(c1)
printstring2 Chr$(c1), k1 * 40 - 38, i1 * 80 - 67, 4, -1, 1
If c1 = 255 Then GoTo 10
Next k1
Next i1
10:
Do
Loop Until InKey$ <> ""
Cls , _RGB(0, 0, 0)
printstring2 "Press Esc to continue", 4, 750, 2, -1, 1
For k = 1 To 9
printstring2 "Size" + LTrim$(Str$(k)), 10, 2 + (k - 1) * k * 8, k, -1, 1
printstring2 "QB64", 400, 2 + (k - 1) * k * 8, k, -2, 1
printstring2 "QB64", 750, 2 + (k - 1) * k * 8, k, -3, 1
Next k
Do
Loop Until InKey$ = Chr$(27)
Cls , _RGB(0, 0, 0)
printstring2 "Press Esc to continue", 4, 750, 2, -1, 1
printstring2 "What is QB64?", 10, 80, 3, -2, 4
printstring2 "QB64 is a BASIC compatible Editor and C++ emitter that creates", 10, 140, 2, -1, 1
printstring2 "working Executable files from QBasic BAS files that can be run", 10, 170, 2, -1, 1
printstring2 "on 32 or 64 bit PC's using Windows (XP to 10), Linux or macOS.", 10, 200, 2, -1, 1
printstring2 "What is QB64? - CRACK EFFECT", 10, 280, 3, -4, 4
printstring2 "QB64 is a BASIC compatible Editor and C++ emitter that creates", 10, 340, 2, -4, 1
printstring2 "working Executable files from QBasic BAS files that can be run", 10, 370, 2, -4, 1
printstring2 "on 32 or 64 bit PC's using Windows (XP to 10), Linux or macOS.", 10, 400, 2, -4, 1
Do
Loop Until InKey$ = Chr$(27)
Cls , _RGB(0, 0, 0)
printstring2 "Press Esc to continue", 5, 5, 2, -1, 1
k = 0
Do
printstring2 "QB64", 50, 50, 10, -1, 2
printstring2 "QB64", 450, 55, 10, -2, 2
printstring2 "QB64", 50, 255, 10, -3, 2
printstring2 Chr$(4) + "QB64" + LTrim$(Chr$(4)), 450, 250, 10, 3, 2
If k < 20 Then printstring2 "QB64", 250 - k * 4, 500 - k * 4, k, 0, 0: k = k + 1
printstring2 "QB64", 250 - k * 4, 500 - k * 4, k, 0, 2
_Delay .04
Loop Until InKey$ = Chr$(27)
Cls
Color _RGB(200, 200, 200), _RGB(0, 0, 0)
printstring2 "Press Esc to continue", 5, 5, 2, -1, 1
k2 = 0: k3 = 0
Do
If k3 < 100 Then k3 = k3 + 1 Else Exit Do
If k3 = 1 Then Cls: k2 = 3
If k3 = 49 Then Cls: k2 = 4
For i = 1 To Lw
For k = 1 To Lh
If Letter(k2, i, k) = 1 Then printstring2 LTrim$(Chr$(k2)), 80 * i + 150, 80 * k - 380, 10, k2, 2
Next k
Next i
_Delay .04
Loop Until InKey$ <> ""
'-----------------------END OF EXAMPLES-------------------------
End
'word$ : word(s) to print
'wleft : left margin
'wtop : top margin
'wsize : size of word(s)
'wstyle: -1
quares, -2:filled squares, -3:circle, -4:crack, 0:random character, 1-254pecific character(1-254)
'wcolor: 0:black, 1:white, 2:multicolored, 3:blue, 4:yellow
Sub printstring2 (word$, wleft, wtop, wsize, wstyle, wcolor)
For wl = 1 To Len(word$)
wl1 = Asc(Mid$(word$, wl, 1))
For i = 0 To Lw
For k = 0 To Lh
If Letter(wl1, i, k) = 1 Then
Select Case wcolor 'replace with your own color
Case 0
Color1& = _RGB(0, 0, 0)
Case 1
Color1& = _RGB(250, 250, 250)
Case 2
Color1& = _RGB(150 + Rnd * 100, 100 + Rnd * 150, Rnd * 250)
Case 3
Color1& = _RGB(50, 50, 250)
Case 4
Color1& = _RGB(250, 250, 50)
End Select
Select Case wstyle
Case -1
k2 = 1
Line (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k)-(wleft + wsize * wl * Lw + wsize * i - wsize * Lw + wsize - k2, wtop + wsize * k + wsize - k2), Color1&, B
Case -2
k2 = 2
Line (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k)-(wleft + wsize * wl * Lw + wsize * i - wsize * Lw + wsize - k2, wtop + wsize * k + wsize - k2), Color1&, BF
Case -3
Circle (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k), Int(wsize / 2), Color1&, 0, 2 * _Pi, 1
Case -4
k2 = Rnd * wsize + 2
Line (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k)-(wleft + wsize * wl * Lw + wsize * i - wsize * Lw + wsize - k2, wtop + wsize * k + wsize - k2), Color1&, B
Case 1 To 255
Color Color1&, _RGBA(0, 0, 0, 0): _PrintString (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k), LTrim$(Chr$(wstyle))
Case 0
Color Color1&, _RGB(0, 0, 0): _PrintString (wleft + wsize * wl * Lw + wsize * i - wsize * Lw, wtop + wsize * k), Chr$(Int(Rnd * 254) + 1)
End Select
End If
Next k
Next i
Next wl
End Sub
RE: Text Effects 2 - hsiangch_ong - 10-29-2025
well done. credit.
i guess most of this code could be ported to freebasic. since that doesn't have native font loading. but has draw string statement.
the first screen this program generates. might be better for people with 4k screens. because the first portion of it was cut off on my ageing laptop. with 1366x768 screen dimensions.
RE: Text Effects 2 - Unseen Machine - 10-29-2025
I got to say it does look cool but on a side note, it's been done, done and done again! I did my first one of these in 2009 and I was 30 years late to the party!
I would be extra impressed if you did a solid variant that smoothed the edges or even made triangles for the blocks to simulate smoothing....
Still +1 From me for giving it a crack and an excellent demo
Unseen
RE: Text Effects 2 - smooth edges (size 2 only) - 2112 - 10-30-2025
Code: (Select All)
handle& = _NewImage(1020, 600, 32)
Screen handle&
Dim Shared Lw, Lh As Integer
Lw = 8: Lh = 16
Dim Shared Letter(255, Lw, Lh) As Integer
Dim Shared Letter2(255, Lw * 2 + 1, Lh * 2 + 1) As Integer
Cls , _RGB(0, 0, 0)
Color _RGB(1, 1, 1), _RGB(0, 0, 0)
For ch = 1 To 255 '----------LOAD CHARACTERS TO ARRAY
_PrintString (0, 0), Chr$(ch)
For i = 1 To Lw
For k = 1 To Lh
Letter(ch, i, k) = 0
If Point(i - 1, k - 1) = _RGB(1, 1, 1) Then
Letter(ch, i, k) = 1
Letter2(ch, i * 2, k * 2) = 1: Letter2(ch, i * 2 + 1, k * 2) = 1: Letter2(ch, i * 2, k * 2 + 1) = 1: Letter2(ch, i * 2 + 1, k * 2 + 1) = 1
End If
Next k
Next i
Next ch
Cls , _RGB(0, 0, 0)
printstring3 "What is QB64?", 10, 80, 3, -2, 4
printstring3 "QB64 is a BASIC compatible Editor and C++ emitter that creates", 2, 140, 2, -4, 1
printstring3 "working Executable files from QBasic BAS files that can be run", 2, 170, 2, -4, 1
printstring3 "on 32 or 64 bit PC's using Windows (XP to 10), Linux or macOS.", 2, 200, 2, -4, 1
For ch = 1 To 255
For i = 1 To Lw * 2
For k = 1 To Lh * 2
If i > 1 And k > 1 And Letter2(ch, i, k) = 1 And Letter2(ch, i - 1, k) = 0 And Letter2(ch, i, k - 1) = 0 Then Letter2(ch, i, k) = 2 'LEFT UP
If i > 1 And k < Lh * 2 And Letter2(ch, i, k) = 1 And Letter2(ch, i - 1, k) = 0 And Letter2(ch, i, k + 1) = 0 Then Letter2(ch, i, k) = 3 'LEFT DOWN
If i < Lw * 2 And k > 1 And Letter2(ch, i, k) = 1 And Letter2(ch, i + 1, k) = 0 And Letter2(ch, i, k - 1) = 0 Then Letter2(ch, i, k) = 4 'RIGHT UP
If i < Lw * 2 And k < Lh * 2 And Letter2(ch, i, k) = 1 And Letter2(ch, i + 1, k) = 0 And Letter2(ch, i, k + 1) = 0 Then Letter2(ch, i, k) = 5 'RIGHT DOWN
Next k
Next i
Next ch
For ch = 1 To 255
For i = 1 To Lw * 2
For k = 1 To Lh * 2
If i > 1 And k > 1 And Letter2(ch, i, k) = 0 And Letter2(ch, i - 1, k) = 1 And Letter2(ch, i, k - 1) = 1 Then Letter2(ch, i, k) = 7 'LEFT UP
If i > 1 And k < Lh * 2 And Letter2(ch, i, k) = 0 And Letter2(ch, i - 1, k) = 1 And Letter2(ch, i, k + 1) = 1 Then Letter2(ch, i, k) = 7 'LEFT DOWN
If i < Lw * 2 And k > 1 And Letter2(ch, i, k) = 0 And Letter2(ch, i + 1, k) = 1 And Letter2(ch, i, k - 1) = 1 Then Letter2(ch, i, k) = 7 'RIGHT UP
If i < Lw * 2 And k < Lh * 2 And Letter2(ch, i, k) = 0 And Letter2(ch, i + 1, k) = 1 And Letter2(ch, i, k + 1) = 1 Then Letter2(ch, i, k) = 7 'RIGHT DOWN
Next k
Next i
Next ch
printstring3 "What is QB64? - smooth EFFECT", 10, 280, 3, -4, 4
printstring3 "QB64 is a BASIC compatible Editor and C++ emitter that creates", 2, 340, 2, -4, 1
printstring3 "working Executable files from QBasic BAS files that can be run", 2, 370, 2, -4, 1
printstring3 "on 32 or 64 bit PC's using Windows (XP to 10), Linux or macOS.", 2, 400, 2, -4, 1
End
Sub printstring3 (word$, wleft, wtop, wsize, wstyle, wcolor)
If wcolor = 4 Then color1& = _RGB(200, 200, 0): color1b& = _RGBA(200, 200, 0, 200)
If wcolor = 1 Then color1& = _RGB(200, 200, 200): color1b& = _RGBA(200, 200, 200, 200)
For wl = 1 To Len(word$)
wl1 = Asc(Mid$(word$, wl, 1))
For i = 1 To Lw * 2
For k = 1 To Lh * 2
If Letter2(wl1, i, k) = 1 Then PSet (wleft + wl * Lw * 2 + i, wtop + k), color1&
If Letter2(wl1, i, k) = 7 Then PSet (wleft + wl * Lw * 2 + i, wtop + k), color1b&
Next k
Next i
Next wl
End Sub
RE: Text Effects 2 - NakedApe - 10-30-2025
+1 for the Text Effect 2 prog in Post #1 here. That's cool stuff. This latest one (Post #4) doesn't do anything for me but display the one screen of text. What am I missing?
RE: Text Effects 2 - 2112 - 10-30-2025
(10-30-2025, 10:39 PM)NakedApe Wrote: +1 for the Text Effect 2 prog in Post #1 here. That's cool stuff. This latest one (Post #4) doesn't do anything for me but display the one screen of text. What am I missing?Unseen Machine wrote a message about smoothing the edges
of the text. That's all I could do, it works only in double size.
If you look closesly you will see the second text is smoother than the first (post #4)
RE: Text Effects 2 - Unseen Machine - 10-30-2025
(10-30-2025, 10:50 PM)2112 Wrote: Unseen Machine wrote a message about smoothing the edgesNice, can defo see the difference...+1 again!
of the text. That's all I could do, it works only in double size.
If you look closesly you will see the second text is smoother than the first (post #4)
Unseen