Text Effects 2

[2112]

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: -1quares, -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

[hsiangch_ong]

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.

[Unseen Machine]

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

[2112]

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

[NakedApe]

+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?

[2112]

+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)

[Unseen Machine]

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)

Nice, can defo see the difference...+1 again!

Unseen