Koodit: QB: Liukuvärjätty teksti

DECLARE SUB PrintElite (x%, y%, teksti$, varit%())

'kerää kirjaimet taulukkoon
DIM SHARED kirjaimet(255, 64) AS INTEGER
SCREEN 13
FOR h = 0 TO 255
  IF h <> 7 THEN LOCATE 1, 1: PRINT CHR$(h)
  in = 0
  FOR i = 0 TO 7
    FOR j = 0 TO 7
      kirjaimet(h, in) = SGN(POINT(i, j))
      in = in + 1
  NEXT j, i
NEXT

'VÄRIT, yhdellä PrintElite-sessiolla voi valitettavasti
'olla vain yksi liukuvärjäys

'vasen puoli: R, G, B
v%(0) = 0
v%(1) = 0
v%(2) = 20
'oikea puoli: R, G, B
v%(3) = 180
v%(4) = 180
v%(5) = 255

teksti$ = "Ohjelmointiputka - QB, VB ja PHP"
tx% = 5
ty% = 5

PrintElite tx%, ty%, teksti$, v%()

SUB PrintElite (x%, y%, teksti$, varit%())
  tx% = x%
  ty% = y%
  pituus% = LEN(teksti$) * 9
  askel% = 1
  IF pituus% > 200 THEN
    pituus% = LEN(teksti$) * 4.5
    askel% = 2
  END IF

  'RGB vasemmalla
  ar = varit%(0)
  ag = varit%(1)
  ab = varit%(2)

  'RGB oikealla
  lr = varit%(3)
  lg = varit%(4)
  lb = varit%(5)

  fr = (lr - ar) / pituus%
  fg = (lg - ag) / pituus%
  fb = (lb - ab) / pituus%

  nr = ar
  ng = ag
  nb = ab

  CLS
  FOR k = 1 TO LEN(teksti$)
    h = ASC(MID$(teksti$, k, 1))
    in = 0
    FOR i = 0 TO 7
      IF vin% MOD askel% = 0 AND vin% < 199 THEN
        nr = nr + fr
        ng = ng + fg
        nb = nb + fb
        OUT &H3C8, 50 + vin%
        OUT &H3C9, nr \ 4
        OUT &H3C9, ng \ 4
        OUT &H3C9, nb \ 4
        vari% = 50 + vin%
      END IF
      vin% = vin% + 1
      FOR j = 0 TO 7
        PSET (tx% + i, ty% + j), kirjaimet(h, in) * vari%
        'kirjaimet(h, in) = SGN(POINT(i, j))
        in = in + 1
    NEXT j, i
    tx% = tx% + 8
  NEXT
END SUB