' Resizable VGA Font Routine
' Written by Bryan Flick
' (C) Copyright 1992, All Rights Reserved
 
' Below is a font routine that I wrote in QuickBASIC 4.5. With the PrintText
' subroutine, it is possible to print scalable characters, in any of 16
' colors, in either underline, italics, or shadow mode (or a combination of
' any three). Works only in VGA mode.
COMMON SHARED a$: ' A$    = String to print
COMMON SHARED col1: ' Col1  = Color of font
COMMON SHARED col2: ' Col2  = Background color of font (used with shadow)
COMMON SHARED t: ' T     = Tool (0=none, 1=underline, 2=italics, 4=shadow)
COMMON SHARED x: ' X     = Starting X position       (in pixels)
COMMON SHARED y: ' Y     = Starting Y position       (in pixels)
COMMON SHARED Xsize: ' XSize = Size of font horizontally (in pixels)
COMMON SHARED Ysize: ' YSize = Size of font vertically   (in pixels)
 
DEFINT A-Z: DIM Font(94, 8, 16), XS(8), YS(16): GOTO Start
 
PrintText:

 
IX = Xsize \ 8: IY = Ysize \ 16
T1 = t AND 1
T2 = t AND 2: IF T2 <> 0 THEN T2 = 1
T3 = t AND 4: IF T3 <> 0 THEN T3 = 1
 
XS = IX * 8: YS = IY * 16
FOR I = 1 TO 8: XS(I) = IX: NEXT I
FOR I = 1 TO 16: YS(I) = IY: NEXT I
 
IF XS <> Xsize THEN FOR I = 1 TO Xsize - XS: XS(I) = XS(I) + 1: NEXT I
 
IF YS <> Ysize THEN FOR I = 1 TO Ysize - YS: YS(I) = YS(I) + 1: NEXT I
 
FOR I = 1 TO LEN(a$): C = ASC(MID$(a$, I, 1))
 
IF C = 13 THEN x = 0: y = y + Ysize: IF y < 480 GOTO Oops ELSE RETURN
IF C = 32 THEN x = x + Xsize: IF x < 640 GOTO Oops ELSE RETURN
 
IF C >= 33 AND C <= 127 THEN Char = C - 32
 
TD1:    XS2 = Font(Char, 0, 0): XS3 = 0
        FOR a = 1 TO XS2: XS3 = XS3 + XS(a): NEXT a
        IF x + XS3 > 639 THEN RETURN
        X2 = x: Y2 = y
        FOR K = 1 TO 16: Z1 = YS(K): IF Z1 = 0 THEN 96
        FOR J = 1 TO XS2: Z2 = XS(J): IF Z2 = 0 THEN 95
        IF Font(Char, J, K) = 0 GOTO TD2
        X9 = x + Z2 - 1: Y9 = y + Z1 - 1
        IF T2 = 1 GOTO T2
        IF T3 = 1 THEN LINE (x + IX, y + IY)-(X9 + IX, Y9 + IY), col2, BF
        LINE (x, y)-(X9, Y9), col1, BF
        GOTO TD2
T2:     Q = (4 - K \ 2) * IX
        IF T3 = 1 THEN LINE (x + Q + IX, y + IY)-(X9 + Q + IX, Y9 + IY), col2, BF
        LINE (x + Q, y)-(X9 + Q, Y9), col1, BF
TD2:    x = x + Z2
95      NEXT J: x = X2: y = y + Z1
96      NEXT K: y = Y2
        IF T1 = 1 THEN LINE (x, y + Ysize - 2)-(x + XS3, y + Ysize - 2), col1
        IF T1 = 1 AND T3 = 1 THEN LINE (x + 1, y + Ysize - 1)-(x + XS3 + 1, y + Ysize - 1), col2
        x = x + XS3 + 1
Oops:   NEXT I
 
RETURN
 
Start: SCREEN 12: COLOR 15: PRINT "Please wait...": COLOR 1
 
Char1 = 1
        FOR Char2 = 33 TO 126
        LOCATE 2, 1: PRINT CHR$(Char2)
        FOR J = 1 TO 16: FOR I = 1 TO 8
        Font(Char1, I, J) = POINT(I - 1, J + 15)
        NEXT I, J
        I = 8: a = 0
2691    FOR J = 1 TO 8: IF Font(Char1, I, J) <> 0 THEN a = 1
        NEXT J
        IF a = 0 THEN I = I - 1: IF I <> 1 THEN 2691
        Font(Char1, 0, 0) = I
        Char1 = Char1 + 1
        NEXT Char2
 
x = 0: y = 0: t = 0: Xsize = 8: Ysize = 16
 
CLS : COLOR 15
 
a$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!@#$%^&*)"
 
PRINT "This is a sample of the 8x16 font...": PRINT
col1 = 10: x = 0: y = 16: GOSUB PrintText
PRINT "This is a sample of the 8x16 font underlined...": PRINT
col1 = 11: t = 1: x = 0: y = 48: GOSUB PrintText
PRINT "This is a sample of the 8x16 font italicized...": PRINT
col1 = 12: t = 2: x = 0: y = 80: GOSUB PrintText
PRINT "This is a sample of the 8x16 font with shadows...": PRINT
col1 = 13: col2 = 5: t = 4: x = 0: y = 112: GOSUB PrintText
PRINT "This is a sample of the 8x16 font underlined, italicized, with shadows... ": PRINT ""
col1 = 14: col2 = 6: t = 7: x = 0: y = 144: GOSUB PrintText
PRINT "This is a sample of the 16x16 font...": PRINT
col1 = 10: t = 0: x = 0: y = 176: Xsize = 16: GOSUB PrintText
PRINT "This is a sample of the 8x32 font...": PRINT : PRINT
col1 = 11: x = 0: y = 208: Xsize = 8: Ysize = 32: GOSUB PrintText
PRINT "This is a sample of the 32x32 HEADLINE font, with shadows!":
PRINT : PRINT : PRINT
col1 = 12: col2 = 4: t = 4: x = 0: y = 256: Xsize = 12: Ysize = 24
GOSUB PrintText
PRINT TAB(29); "Written by Bryan Flick"
PRINT TAB(32); "53 Olde Mill Run"
PRINT TAB(30); "Stroudsburg, PA 18360"
PRINT TAB(27); "717-421-1764 (24 hour BBS)": PRINT
COLOR 11: PRINT TAB(21); "(C) Copyright 1992, All Rights Reserved"
SLEEP
CLS
DO

 ke$ = INKEY$
 IF ke$ <> "" THEN a$ = a$ + ke$
 col1 = 10: x = 0: y = 16: GOSUB PrintText

LOOP UNTIL ke$ = CHR$(27)

SLEEP: END
 
' That's it! Hopefully the echo doesn't butcher the program up too
' much, if so just let me know and I'll find another way to resend
' it! If you take a look at it, I'd appreciate it if you let me know
' what you think! Thanks!

SUB typewrite


END SUB

