10-18-2025, 02:19 PM
Code: (Select All)
'=========================================================
'THIS PROGRAM USES THE LUCIDA CONSOLE REGULAR FONT (LUCON.TTF)
'OTHER FONTS MAY NOT SHOW THE TEXT CORRECTLY
'REDUCE THE fontsize% IN BOTH GOSUBS IF YOU GET AN ERROR
handle& = _NewImage(800, 600, 32)
Screen handle&
'--------typewriter data----------
LINES1% = 5
Dim TEXT$(LINES1%)
TEXT$(1) = "TYPEWRITER EFFECT"
TEXT$(2) = "CLS [method%] [, bgColor&]"
TEXT$(3) = "COLOR [foreground&][, background&]"
TEXT$(4) = "PRINT [expression] [;|,] [expression...]"
TEXT$(5) = "QB64 is a BASIC compatible Editor"
RED$ = "QB64" ' prints "qb64" in red background
'--------------------------------
'--------glowing letters data-------------
Dim a1lines As Integer
a1lines = 9
Dim A1$(a1lines)
Dim wi%(50)
Dim wi2%(50)
Dim wb$(50)
BGCOLOR1& = _RGB(0, 0, 150)
BGCOLOR2& = _RGB(0, 0, 80)
'-----------------------------------------
Cls , _RGB(0, 0, 80)
_Delay .5
GoSub typewriter
_Delay 1
GoSub GlowLetters
End
'---------------------gosubs-----------------------
typewriter:
Fontname$ = Environ$("SYSTEMROOT") + "\fonts\LUCON.TTF"
fontsize% = 20
style$ = "MONOSPACE"
font& = _LoadFont(Fontname$, fontsize%, style$)
_Font font&
B$ = "": COL4& = _RGB(200, 230, 22)
TW = 0: TW3% = 0: TW4% = 0
TW2% = Len(RED$)
LEFTMARGIN = 2
TOPMARGIN = 2
Locate TOPMARGIN, LEFTMARGIN
For k = 1 To LINES1%
L = Len(TEXT$(k))
Locate , LEFTMARGIN, 1, 10, 10
For i = 1 To L
B$ = Mid$(TEXT$(k), i, 1)
If Mid$(TEXT$(k), i, TW2%) = RED$ Then TW3% = 1
COL3& = Int(Rnd(10) * 70 + 180)
COL4& = _RGB(255, COL3& - 40, COL3& - 80)
If TW3% = 1 Then
Color COL4&, _RGB(120, 0, 0)
Else
Color COL4&, _RGBA(0, 0, 80, 0)
End If
If TW3% = 1 Then TW4% = TW4% + 1
If TW4% = TW2% Then TW3% = 0: TW4% = 0
Print B$;
Color _RGB(255, 0, 0), _RGBA(0, 0, 80, 0)
Print Mid$(TEXT$(k), i + 1, 1);
Color , _RGBA(0, 0, 80, 0)
Sound 8000, .1
_Delay .04
If i < L Then Locate , Pos(0) - 1 Else Locate , Pos(0)
Next i
If k < LINES1% Then Print ""
Next k
Return
'-----------------------------------------------------------
GlowLetters:
Cls , _RGB(0, 0, 80)
fontpath$ = Environ$("SYSTEMROOT") + "\fonts\LUCON.ttf"
fontsize% = 30
style$ = "MONOSPACE"
font& = _LoadFont(fontpath$, fontsize%, style$)
_Font font&
LEFTMARGIN = 2
TOPMARGIN = 2
CK3% = 0
Do
Select Case CK3%
Case 100
A1$(1) = " "
A1$(2) = " QB64 is a BASIC compatible "
A1$(3) = " Editor and C++ emitter that "
A1$(4) = " creates working Executable "
A1$(5) = " files from QBasic BAS files "
A1$(6) = " that can be run on 32 or 64 "
A1$(7) = " bit PC's using Windows "
A1$(8) = " (XP to 10), Linux or macOS "
A1$(9) = " "
Case 500
A1$(1) = " "
A1$(2) = " "
A1$(3) = " "
A1$(4) = " QBasic is more alive "
A1$(5) = " than ever with QB64! "
A1$(6) = " "
A1$(7) = " "
A1$(8) = " "
A1$(9) = " "
Case 700
A1$(1) = " "
A1$(2) = " "
A1$(3) = " "
A1$(4) = " Press ESC... "
A1$(5) = " to Exit "
A1$(6) = " "
A1$(7) = " "
A1$(8) = " "
A1$(9) = " "
End Select
For wk% = 1 To 50
wi%(wk%) = Int(Rnd * a1lines) + 1
wi2%(wk%) = Int(Rnd * Len(A1$(wi%(wk%)))) + 1
wb$(wk%) = Mid$(A1$(wi%(wk%)), wi2%(wk%), 1)
Color _RGB(255, 255, 255), BGCOLOR1&
Locate TOPMARGIN + wi%(wk%), LEFTMARGIN + wi2%(wk%) - 1: Print wb$(wk%)
Next wk%
_Delay .005
COL4& = _RGB(255, Int(Rnd * 70 + 180) - 40, Int(Rnd * 70 + 180) - 80)
Color COL4&, BGCOLOR2&
For wk% = 1 To 50
Locate TOPMARGIN + wi%(wk%), LEFTMARGIN + wi2%(wk%) - 1: Print wb$(wk%)
Next wk%
If CK3% < 800 Then CK3% = CK3% + 1 Else CK3% = 0
Loop Until InKey$ = Chr$(27)
Return
