03-25-2025, 04:54 PM
(This post was last modified: 03-25-2025, 05:17 PM by madscijr.
Edit Reason: turns out that unused code wasn't unused, so i put it back!
)
Here's what I have so far, for printing text in a big font.
Then to smoothly scroll, I'd have to redraw slightly shifted over.
Is there a better way to do this?
I'm not crazy about this relying on an array or drawing a rectangle for every pixel, it seems like it could be easier and more efficient.
I vaguely recall seeing different examples of printing a bigger font and smoothly scrolling big text to a hires screen, but can't seem to find them.
Then to smoothly scroll, I'd have to redraw slightly shifted over.
Is there a better way to do this?
I'm not crazy about this relying on an array or drawing a rectangle for every pixel, it seems like it could be easier and more efficient.
I vaguely recall seeing different examples of printing a bigger font and smoothly scrolling big text to a hires screen, but can't seem to find them.
Code: (Select All)
Dim in$
Dim iChar As Integer
Dim sChar$
Dim iStartX As Integer
Dim x%, y%
Dim fgColor~&
Dim bgColor~&
Dim scale%
ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
GetBigFont arrAlpha()
imgScreen& = _NewImage(1024, 768, 32)
Screen imgScreen&: _ScreenMove 0, 0: Cls , _RGB32(0, 0, 0)
iStartX = 100
bgColor~& = _RGB32(0, 0, 0)
x% = iStartX: y% = 75
scale% = 2: in$ = "Hi": fgColor~& = _RGB32(255, 0, 0)
PrintBigText imgScreen&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
x% = x% + (Len(in$) * _FontWidth * scale%): y% = 75
scale% = scale% + 1: in$ = "how": fgColor~& = _RGB32(255, 255, 0)
PrintBigText imgScreen&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
x% = x% + (Len(in$) * _FontWidth * scale%): y% = 75
scale% = scale% + 1: in$ = "are": fgColor~& = _RGB32(0, 255, 0)
PrintBigText imgScreen&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
x% = x% + (Len(in$) * _FontWidth * scale%): y% = 75
scale% = scale% + 1: in$ = "you": fgColor~& = _RGB32(0, 255, 255)
PrintBigText imgScreen&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
x% = x% + (Len(in$) * _FontWidth * scale%): y% = 75
scale% = scale% + 1: in$ = "??": fgColor~& = _RGB32(0, 0, 255)
PrintBigText imgScreen&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
Color _RGB32(0, 255, 255), _RGB32(0, 0, 0)
_PrintString (1, _Height(imgScreen&) - _FontHeight), "Press any key to exit."
Sleep
Screen 0: Cls: Print "Finished"
If imgScreen& < -1 Or imgScreen& > 0 Then _FreeImage imgScreen&
End
' /////////////////////////////////////////////////////////////////////////////
Sub PrintBigText (imgDest&, in$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha() As Integer)
Dim iChar As Integer
Dim sChar$
Dim x1%, y1%
' Make sure we have a valid image handle
If imgDest& < -1 Or imgDest& > 0 Then
' Make sure scale% >0
If scale% > 0 Then
' Make sure sChar$ is not blank and arrAlpha is DIMmed
''ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
if len(in$)>0 and _
lbound(arrAlpha,1)>=32 and ubound(arrAlpha,1) <=127 _
and lbound(arrAlpha,2) =1 and ubound(arrAlpha,2) = _FontWidth _
and lbound(arrAlpha,3) =1 and ubound(arrAlpha,3) = _FontHeight then
x1% = x%: y1% = y%
For iChar = 1 To Len(in$)
sChar$ = Mid$(in$, iChar, 1)
PrintBigChar imgDest&, sChar$, x1%, y1%, fgColor~&, bgColor~&, scale%, arrAlpha()
x1% = x1% + (_FontWidth * scale%) ' move forward 1 character
Next iChar
End If
End If
End If
End Sub ' PrintBigText
' /////////////////////////////////////////////////////////////////////////////
' Usage:
' PrintBigChar imgDest&, sChar$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha()
Sub PrintBigChar (imgDest&, sChar$, x%, y%, fgColor~&, bgColor~&, scale%, arrAlpha() As Integer)
Dim iChar As Integer
Dim x1%, y1%, x2%, y2%
' Make sure we have a valid image handle
If imgDest& < -1 Or imgDest& > 0 Then
' Make sure scale% >0
If scale% > 0 Then
' Make sure sChar$ is not blank and arrAlpha is DIMmed
''ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
if len(sChar$)>0 and _
lbound(arrAlpha,1)>=32 and ubound(arrAlpha,1) <=127 _
and lbound(arrAlpha,2) =1 and ubound(arrAlpha,2) = _FontWidth _
and lbound(arrAlpha,3) =1 and ubound(arrAlpha,3) = _FontHeight then
' Make sure ASCII code is in the range of our array
iChar = Asc(Left$(sChar$, 1))
If (iChar >= LBound(arrAlpha, 1)) And (iChar <= UBound(arrAlpha, 1)) Then
' Print sChar$ as big letter at x%, y% in color fg~&, bg~&
y1% = y%
For sy = 1 To _FontHeight
x1% = x% ' start each line at beginning
y2% = y1% + (scale% - 1) ' calculate y endpoint
For sx = 1 To _FontWidth
x2% = x1% + (scale% - 1) ' calculate x endpoint
If arrAlpha(iChar, sx, sy) = _TRUE Then
Line (x1%, y1%)-(x2%, y2%), fgColor~&, BF
Else
Line (x1%, y1%)-(x2%, y2%), bgColor~&, BF
End If
x1% = x1% + scale% ' move x over by scale%
Next sx
y1% = y1% + scale% ' move y down by scale%
Next sy
End If
End If
End If
End If
End Sub ' PrintBigChar
' /////////////////////////////////////////////////////////////////////////////
Sub GetBigFont (arrAlpha() As Integer)
Dim imgChar As Long
Dim iChar As Integer
Dim sx, sy As Integer
Dim c~&
Dim r As Integer
ReDim arrAlpha(32 To 127, 1 To _FontWidth, 1 To _FontHeight) As Integer
InitImage imgChar, _FontWidth, _FontHeight, _RGB32(0, 0, 0)
For iChar = 32 To 127
_Dest imgChar
_Source imgChar
Color _RGB32(255, 0, 0), _RGB32(0, 0, 0)
_PrintString (0, 0), Chr$(iChar)
For sy = 0 To (_FontHeight - 1)
For sx = 0 To (_FontWidth - 1)
c~& = Point(sx, sy)
r = _Red32(c~&): ' g = _Green32(c~&) : b = _Blue32(c~&) : a = _Alpha32(c~&)
If r = 255 Then
arrAlpha(iChar, sx + 1, sy + 1) = _TRUE
Else
arrAlpha(iChar, sx + 1, sy + 1) = _FALSE
End If
Next sx
Next sy
Next iChar
If imgChar< -1 Or imgChar > 0 Then _FreeImage imgChar
End Sub ' GetBigFont
' /////////////////////////////////////////////////////////////////////////////
Function cEmpty~& ()
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' /////////////////////////////////////////////////////////////////////////////
Sub InitImage (ThisImage&, iWidth&, iHeight&, bgColor~&)
FreeImage ThisImage&
ThisImage& = _NewImage(iWidth&, iHeight&, 32)
_Dest ThisImage&: Cls , bgColor~&
End Sub ' InitImage
' /////////////////////////////////////////////////////////////////////////////
Sub FreeImage (ThisImage&)
If ThisImage& < -1 Or ThisImage& > 0 Then _FreeImage ThisImage&
End Sub ' FreeImage