Keskustelu: Koodit: QB: Kuvion täyttäminen

Antti Laaksonen [17.10.2002 19:07:33]

Tämä listaus sisältää aliohjelman TaytaKuvio, joka täyttää tietyllä värillä rajatun alueen toisella värillä, vähän niinkuin QB:n oma PAINT-käsky. Käskynä tämä on varmasti PAINTia hitaampi, mutta tätä voi halutessaan muokata ja lisätä omia ominaisuuksia (kuvion pinta-alan laskenta, neliöpikseleitä ;)..). Ja jos taitoa riittää, voihan tämän kääntää assemblyllekin.

'TaytaKuvio-aliohjelman käyttämä datatyyppi
TYPE tt
  s AS INTEGER
  m AS INTEGER
END TYPE

'piirretään esimerkkikuvio
SCREEN 13
LINE (1, 1)-(319, 199), 15, B
CIRCLE (50, 50), 20
LINE (50, 50)-(100, 100), 15
LOCATE 2, 2: PRINT "Paina ENTER..."
FOR i% = 5 TO 195 STEP 2
  LINE (250 + (i% MOD 25) * 1, i%)-(300 - (i% MOD 25) * 1, i%)
NEXT

'odotetaan näppäimen painallusta
SLEEP

'täytetään kuvio sinisellä, valkoinen väri muodostaa ääriviivat
TaytaKuvio 100, 50, 1, 15

SLEEP

SUB TaytaKuvio (x%, y%, v%, tv%)
  'taulukko "risteyskohdille"
  DIM t(16000) AS tt
  'aloituskohta näyttömuistissa
  k& = 320 * y% + x%
  'oikea segmentti
  DEF SEG = &HA000
  DO
    'piirretään piste tämän hetkiseen kohtaan
    POKE k&, v%
    'jos vasemmalla ei ole valkoista tai täyttöväriä
    IF PEEK(k& - 1) <> tv% AND PEEK(k& - 1) <> v% THEN
      IF t(i%).s = 1 THEN
        t(i%).m = t(i%).m + 1
      ELSE
        i% = i% + 1: t(i%).s = 1: t(i%).m = 1
      END IF
      k& = k& - 1: o% = 1
    'jos ylhäällä ei ole valkoista tai täyttöväriä
    ELSEIF PEEK(k& - 320) <> tv% AND PEEK(k& - 320) <> v% THEN
      IF t(i%).s = 2 THEN
        t(i%).m = t(i%).m + 1
      ELSE
        i% = i% + 1: t(i%).s = 2: t(i%).m = 1
      END IF
      k& = k& - 320: o% = 2
    'jos oikealla ei ole valkoista tai täyttöväriä
    ELSEIF PEEK(k& + 1) <> tv% AND PEEK(k& + 1) <> v% THEN
      IF t(i%).s = 3 THEN
        t(i%).m = t(i%).m + 1
      ELSE
        i% = i% + 1: t(i%).s = 3: t(i%).m = 1
      END IF
      k& = k& + 1: o% = 3
    'jos alhaalla ei ole valkoista tai täyttöväriä
    ELSEIF PEEK(k& + 320) <> tv% AND PEEK(k& + 320) <> v% THEN
      IF t(i%).s = 4 THEN
        t(i%).m = t(i%).m + 1
      ELSE
        i% = i% + 1: t(i%).s = 4: t(i%).m = 1
      END IF
      k& = k& + 320: o% = 4
    ELSE
      'palataan takaisin risteyskohtiin
      SELECT CASE t(i%).s
      CASE 1: k& = k& + 1
      CASE 2: k& = k& + 320
      CASE 3: k& = k& - 1
      CASE 4: k& = k& - 320
      END SELECT
      IF t(i%).m = 1 THEN
        i% = i% - 1
      ELSE
        t(i%).m = t(i%).m - 1
      END IF
    END IF
  LOOP WHILE i% > 0
END SUB

KimmoKM [19.10.2002 11:55:32]

Ihan hieno ja yllättävän nopea.

Puhveli [15.04.2004 20:00:55]

mulle on käyttöä tolle vbssä, kun siinä ei ole PAINTtia, kiitos. ja on yllättävän nopea

Puhveli [15.04.2004 20:01:14]

siis toi ohjelmasi on nopea :)

Dude [24.08.2007 17:20:07]

Ku kopioi tuon toiseen ohojelmaan niin tulee "Overflow" siinä k& muuttujan kohoras, mutta tuo toimii(se toinen oli se aaltojuttu).

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku