Keskustelu: Koodit: QB: sateenkaariteksti

DECLARE SUB sateenkaari (rivi!, paikka!, teksti$)
SCREEN 13
DIM SHARED fontit(1 TO 255) AS STRING
' ladataan fontit
FOR i = 1 TO 255
  IF NOT i = 7 THEN
    COLOR 16: LOCATE 1, 1: PRINT CHR$(i)
    FOR x = 0 TO 8
      FOR y = 0 TO 8
        IF POINT(x, y) = 16 THEN fontit(i) = fontit(i) + "1":  ELSE fontit(i) = fontit(i) + "0"
      NEXT
    NEXT
  END IF
NEXT

sateenkaari 1, 1, "sateenkaari"
sateenkaari 2, 1, "by: snakari"
sateenkaari 3, 1, "https://www.ohjelmointiputka.net"
sateenkaari 4, 1, "saattaa olla sekavaa koodia, mutta ihme kyllä toimii"
SLEEP

SUB sateenkaari (rivi, paikka, teksti$)
vari = 32
paikka = paikka * 9 - 9
rivi = rivi * 9 - 9
DEF SEG = &HA000
FOR k = 1 TO LEN(teksti$)
  kirjain$ = MID$(teksti$, k, 1)
  FOR x = 0 TO 8
    FOR y = 0 TO 8
      p = p + 1
      v = VAL(MID$(fontit(ASC(kirjain$)), p, 1))
      IF v = 1 THEN
        POKE (paikka + x) + (rivi + y) * 320, vari: vari = vari + 1
      END IF
      IF vari = 100 THEN vari = 32
    NEXT
  NEXT
  paikka = paikka + 8
  IF paikka >= 319 THEN paikka = 0: rivi = rivi + 9
  p = 0
NEXT
END SUB