Keskustelu: Koodit: QB: tekstin suurennus 2

'saa käyttää vapaasti, tosin tekijän saa kuitenkin mainita :D
DECLARE SUB lataa ()
DECLARE SUB text (rivi AS INTEGER, paikka AS INTEGER, teksti AS STRING, vari AS INTEGER, koko AS INTEGER)
SCREEN 13
DIM SHARED fontit(1 TO 255) AS STRING
lataa

text 1, 1, "suurenna tekstiä", 13, 2
text 20, 1, "snakari@hotmail.com", 10, 2
text 40, 1, "www.snakari.cjb.net", 14, 2

SUB lataa
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
END SUB

SUB text (rivi AS INTEGER, paikka AS INTEGER, teksti AS STRING, vari AS INTEGER, koko AS INTEGER)
FOR k = 1 TO LEN(teksti)
  kirjain$ = MID$(teksti, k, 1)
  FOR x = 0 TO 8 * koko STEP koko
    FOR y = 0 TO 8 * koko STEP koko
      p = p + 1
      v = VAL(MID$(fontit(ASC(kirjain$)), p, 1))
      IF v = 1 THEN v = vari
      LINE (paikka + x, rivi + y)-(paikka + x + koko, rivi + y + koko), v, BF
    NEXT
  NEXT
  paikka = paikka + 8 * koko
  IF paikka >= 310 THEN paikka = 0: rivi = rivi + 9 * koko
  p = 0
NEXT
END SUB