'===========================================================================
' Subject: VFONT 2 W/FADING COLOURS          Date: 01-09-99 (19:40)       
' Author:  Sam Thursfield                    Code: QB, QBasic, PDS        
' Origin:  sam.thursfield@btinternet.com   Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB VFont (XPos!, YPos!, Text$, Col!, BCol!, Style!)
'VFont V2.0
'By ElvisII AKA Sam Thursfield, 1999
'
'Well, this is a sorta update on VFont. It is better, faster and has the
'fading effect everyone wanted. So here it is. And it's 13h too now.
'
'       -- ElvisII 9 January 1999
'
'   BTW, The styles are:
'
'       Nothing 0
'       Fading 1 -- The colour you give if this is on is the top colour of 8.
'                   So the Palette has to have 8 shades of that colour.
'       Italic 2
'       Shadow 4 -- The shadow fades too. BCol is the shadow colour.
'
'   As usual, use this code in your own programs but give me credit for it. If
'   This does anything wrong like blow up your PC, it's not my fault.
SCREEN 13: CLS

CONST None = 0, Faded = 1, Italic = 2, Shadow = 4

VFont 999, 1, "VFont 2", 29, 25, Shadow + Faded + Italic
VFont 999,1,"Center by specifying X as 999",4,12,Shadow
VFont 999,1,"Fading Italic Shadowed Text!!!",29,26,Shadow+Faded+italic

'Sorry I haven't got time for more of a demo but tea's ready and I'm hungry!

SUB VFont (XPos, YPos, Text$, Col, BCol, Style)
IF XPos = 999 THEN XPos = 160 - INT(LEN(Text$) * 4)
Xx = XPos - 1
Yy = YPos
IF Style AND 4 THEN
    VFont XPos - 1, YPos - 1, Text$, BCol, 0, Style - 4
END IF
FOR Chr = 1 TO LEN(Text$)      'Do each letter
    Xx = Xx + 8               'Step one character
    Ptr = 8 * ASC(MID$(Text$, Chr, 1)) + &HE
    FOR L = 0 TO 7             'Do each line
        DEF SEG = &HFFA6
            BitPattern = PEEK(Ptr + L)
        DEF SEG
        IF Style AND 2 THEN
            IF BitPattern AND 1 THEN PSET (Xx + (7 - (L \ 2)), Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 2 THEN PSET (Xx + (7 - (L \ 2)) - 1, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 4 THEN PSET (Xx + (7 - (L \ 2)) - 2, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 8 THEN PSET (Xx + (7 - (L \ 2)) - 3, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 16 THEN PSET (Xx + (7 - (L \ 2)) - 4, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 32 THEN PSET (Xx + (7 - (L \ 2)) - 5, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 64 THEN PSET (Xx + (7 - (L \ 2)) - 6, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 128 THEN PSET (Xx + (7 - (L \ 2)) - 7, Yy + L), Col - (7 - L) * (Style AND 1)
            IF Style AND 8 AND L = 7 THEN PSET (Xx + (7 - (L \ 2)) - 7, Yy + L), Col - (7 - L) * (Style AND 1)
        ELSE
            IF BitPattern AND 1 THEN PSET (Xx, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 2 THEN PSET (Xx - 1, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 4 THEN PSET (Xx - 2, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 8 THEN PSET (Xx - 3, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 16 THEN PSET (Xx - 4, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 32 THEN PSET (Xx - 5, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 64 THEN PSET (Xx - 6, Yy + L), Col - (7 - L) * (Style AND 1)
            IF BitPattern AND 128 THEN PSET (Xx - 7, Yy + L), Col - (7 - L) * (Style AND 1)
            IF Style AND 8 AND L = 7 THEN PSET (Xx - 7, Yy + L), Col - (7 - L) * (Style AND 1)
        END IF
    NEXT
NEXT
END SUB