Keskustelu: Koodit: QB: Jättikokoinen ASCII-teksti

DECLARE SUB AsciiTxt (tek$, mika.x!, mika.y!, vari!, merkki$)
CLS         'Tämä ohjelma on tehty 'Print joka ei sotke taustaa'
SCREEN 13   '-ohjelman päälle, joka on sekin minun tekemäni :).
DIM SHARED kirjain(1 TO 8, 1 TO 8, 1 TO 255) AS INTEGER
GOSUB fontti.muistiin
SCREEN 12    '<-- muita varten täytyy muokata AsciiTxt -subia
WIDTH 80, 60 '<-- tällä sopii eniten tekstiä :)
GOSUB intro
END

intro:
AsciiTxt "Made By:", .2, 21, 2, "Dj1" 'viimeiseksi asciimerkki tai
AsciiTxt "Dj Wolf:", .2, 31, 2, "Dj2" 'Dj1, Dj2 tai Dj3
RETURN

fontti.muistiin:
FOR asciikoodi = 1 TO 255
IF asciikoodi = 7 THEN asciikoodi = 8 ELSE 'estetään PIIPpaus
COLOR 16: LOCATE 1, 1: PRINT CHR$(asciikoodi)
FOR y = 1 TO 8
FOR x = 1 TO 8
vari = POINT(x - 1, y - 1)
kirjain(x, y, asciikoodi) = vari
NEXT x
NEXT y
NEXT asciikoodi
COLOR 15
RETURN

SUB AsciiTxt (tek$, mika.x, mika.y, vari, merkki$)
SELECT CASE mika.x
 CASE IS = .1: mika.x = 1                  'vasemmalle
 CASE IS = .2: mika.x = 40 - LEN(tek$) * 4 'keskelle
 CASE IS = .3: mika.x = 80 - LEN(tek$) * 8 'oikealle
 CASE ELSE
END SELECT
FOR kerrat = 1 TO LEN(tek$)
asciikoodi = ASC(MID$(tek$, kerrat, 1))
 FOR y = 1 TO 8
  FOR x = 1 TO 8
  IF NOT kirjain(x, y, asciikoodi) = 0 THEN
   kirjain(x, y, asciikoodi) = vari
   LOCATE y + mika.y, x + mika.x: COLOR kirjain(x, y, asciikoodi)
   IF merkki$ = "Dj1" THEN
   SELECT CASE y
    CASE 1 TO 2: PRINT "°"    'pakko oli vähän sisentää,
    CASE 3 TO 4: PRINT "±"    'jotta saisin jotain tolkkua
    CASE 5 TO 6: PRINT "²"    'tästä koodista myöhemmin
    CASE 7 TO 8: PRINT "Û"
   END SELECT
   ELSEIF merkki$ = "Dj2" THEN
    SELECT CASE y
    CASE 1 TO 2: PRINT "Û"
    CASE 3 TO 4: PRINT "²"
    CASE 5 TO 6: PRINT "±"
    CASE 7 TO 8: PRINT "°"
    END SELECT
   ELSEIF merkki$ = "Dj3" THEN
   PRINT MID$(tek$, kerrat, 1)
   ELSE
   PRINT merkki$
   END IF
  ELSE
  END IF
 NEXT x
NEXT y
mika.x = mika.x + 8
NEXT kerrat
END SUB