Eli... monetko (juuri) teistä ovat joskus tuskitelleet GET:llä otettujen kuvien kanssa? Ettei niitä voi muokata jne... Tässä on yksi vaihtoehto (toimii vain ja ainoastaan SCREEN 13-modessa, ja kuvan taulukko on määritettävä integerinä)
Olkaa hyvä.
Kolme (3) subbia, joilla voi käsitellä GET-kuvia.
Toimivat QB:n kaikilla versioilla (testattu wanhalla, 4.5:lla ja 7.1:lla)
Edit - BlitGetToGetTrans tuli kahteen kertaan. Poistettu.
'Koodia by Maestro Sqwiik - suoraan pohjattomasta hatusta! 'Taulukko ON määriteltävä ... AS INEGER => muokkaus helpompaa & nopeampaa SUB ReTouchGet (mikakuva() AS INTEGER, x AS INTEGER, y AS INTEGER, vari AS INTEGER) 'ReTouchGet - piirtää pisteen kuvaan kohtaan x,y värillä 'vari. DIM w AS INTEGER, h AS INTEGER 'kuvan koko DIM kohta AS INTEGER 'mihin kohtaan kuvadataa IF vari < 0 OR vari > 255 THEN EXIT SUB 'Väärä väri w = INT(mikakuva(0) / 8) 'leveys on ensimmäisessä integerissä (* 8) h = mikakuva(1) 'korkeus on "normaalina" toisessa. IF x < 0 OR x > w - 1 OR y < 0 OR y > h - 1 THEN EXIT SUB 'Invalidit koordinaatit... kohta = y * w + x 'lasketaan kohta IF kohta AND 1 THEN 'pariton kohta eli uusi piste menee ylätavuun kohta = INT(kohta / 2) + 2 'monesko intti datassa mikakuva(kohta) = (mikakuva(kohta) AND 255) 'nollataan ylätavu mikakuva(kohta) = mikakuva(kohta) + (vari * 256) 'lisätään uusi ylätavu ELSE 'parillinen, eli alatavuun kohta = INT(kohta / 2) + 2 'monesko intti datassa mikakuva(kohta) = mikakuva(kohta) XOR (mikakuva(kohta) AND 255) 'nollataan alatavu mikakuva(kohta) = mikakuva(kohta) OR vari 'lisätään väri END IF END SUB SUB BlitGetToGet (mista() AS INTEGER, x1 AS INTEGER, y1 AS INTEGER, mihin() AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, w AS INTEGER, h AS INTEGER) 'BlitGetToGet - kopioi kuvan mista kuvaan mihin. x1,y1 ovat '_mistä_ kopsataan, x2,y2 _mihin_ kopioidaan ja w,h 'ovat kopioitavan alueen koko. DIM w1 AS INTEGER, h1 AS INTEGER, w2 AS INTEGER, h2 AS INTEGER 'kuvien koot DIM kohta1 AS INTEGER, kohta2 AS INTEGER DIM x3 AS INTEGER, y3 AS INTEGER, tavu AS INTEGER 'silmukkamuuttujat w1 = INT(mista(0) / 8): h1 = mista(1) w2 = INT(mihin(0) / 8): h2 = mihin(1) 'tarkistetaan kuvan sijainti/koko IF x1 < 0 OR x1 > w1 OR y1 < 0 OR y1 > h1 THEN EXIT SUB 'alkukoord. eivät täsmää IF x2 < 0 OR x2 > w2 OR y2 < 0 OR y2 > h2 THEN EXIT SUB 'loppukoord. eivät täsmää IF x1 + w > w1 OR x2 + w > w2 OR y1 + h > h1 OR y2 + h > h2 THEN EXIT SUB 'koko ei täsmää tavu = 0 FOR y3 = 0 TO h - 1 FOR x3 = 0 TO w - 1 kohta1 = x1 + x3 + ((y1 + y3)) * w1 kohta2 = x2 + x3 + ((y2 + y3)) * w2 'napataan otettava tavu 'ollaan parittomassa eli ylätavua koetellaan IF (kohta1 AND 1) = 1 THEN kohta1 = INT(kohta1 / 2) + 2 'siirretään kuvadataan... tavu = mista(kohta1) XOR (mista(kohta1) AND 255) 'pelkkä ylätavu tavu = INT(tavu / 256) 'jaetaan vielä ELSE 'alatavu... kohta1 = INT(kohta1 / 2) + 2'siirretään kuvadataan... tavu = (mista(kohta1) AND 255)'pelkkä alatavu END IF 'ja piirretään ko. tavu kohteeseen IF (kohta2 AND 1) = 1 THEN 'pariton = ylätavu kohta2 = INT(kohta2 / 2) + 2 'kuvadataan POISTU! mihin(kohta2) = (mihin(kohta2) AND 255) '0:taan ylätavu mihin(kohta2) = mihin(kohta2) + (tavu * 256) 'tavu saatiin ylempää ELSE kohta2 = INT(kohta2 / 2) + 2'siirto kuvadataan mihin(kohta2) = mihin(kohta2) XOR (mihin(kohta2) AND 255) '0:taan alatavu mihin(kohta2) = (mihin(kohta2) OR tavu) 'tavu saatiin ylempää END IF NEXT x3, y3 END SUB SUB BlitGetToGetTrans (mista() AS INTEGER, x1 AS INTEGER, y1 AS INTEGER, mihin() AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, w AS INTEGER, h AS INTEGER, trans AS INTEGER) DIM w1 AS INTEGER, h1 AS INTEGER, w2 AS INTEGER, h2 AS INTEGER 'kuvien koot DIM kohta1 AS INTEGER, kohta2 AS INTEGER DIM x3 AS INTEGER, y3 AS INTEGER, tavu AS INTEGER 'silmukkamuuttujat w1 = INT(mista(0) / 8): h1 = mista(1) w2 = INT(mihin(0) / 8): h2 = mihin(1) 'tarkistetaan kuvan sijainti/koko IF x1 < 0 OR x1 > w1 - 1 OR y1 < 0 OR y1 > h1 - 1 THEN EXIT SUB'alkukoord. eivät täsmää IF x2 < 0 OR x2 > w2 - 1 OR y2 < 0 OR y2 > h2 - 1 THEN EXIT SUB'loppukoord. eivät täsmää IF x1 + w > w1 OR x2 + w > w2 OR y1 + h > h1 OR y2 + h > h2 THEN EXIT SUB 'koko ei sopiva IF trans < 0 OR trans > 255 THEN EXIT SUB 'transuväri ei sopiva tavu = 0 FOR y3 = 0 TO h - 1 FOR x3 = 0 TO w - 1 kohta1 = x1 + x3 + ((y1 + y3)) * w1 kohta2 = x2 + x3 + ((y2 + y3)) * w2 'napataan otettava tavu 'ollaan parittomassa eli ylätavua koetellaan IF (kohta1 AND 1) = 1 THEN kohta1 = INT(kohta1 / 2) + 2 'siirretään kuvadataan... tavu = mista(kohta1) XOR (mista(kohta1) AND 255) 'pelkkä ylätavu tavu = INT(tavu / 256) 'jaetaan vielä ELSE 'alatavu... kohta1 = INT(kohta1 / 2) + 2'siirretään kuvadataan... tavu = (mista(kohta1) AND 255)'pelkkä alatavu END IF 'ja piirretään ko. tavu kohteeseen .. jos ei trans :) IF tavu <> trans THEN IF (kohta2 AND 1) = 1 THEN 'pariton = ylätavu kohta2 = INT(kohta2 / 2) + 2 'kuvadataan POISTU! mihin(kohta2) = (mihin(kohta2) AND 255) '0:taan ylätavu mihin(kohta2) = mihin(kohta2) + (tavu * 256) 'tavu saatiin ylempää ELSE kohta2 = INT(kohta2 / 2) + 2'siirto kuvadataan mihin(kohta2) = mihin(kohta2) XOR (mihin(kohta2) AND 255) '0:taan alatavu mihin(kohta2) = (mihin(kohta2) OR tavu) 'tavu saatiin ylempää END IF END IF NEXT x3, y3 END SUB
DIM kuva(52) AS INTEGER '(10x10 / 2) + 2 = kuvan vaatima tila screen 13:ssa DIM alue(202) AS INTEGER '(20x20) SCREEN 13 LINE (0, 0)-(9, 9), 2, BF 'Piirretään kuvajainen CIRCLE (5, 5), 4, 4 'jolla leikitään GET (0, 0)-(9, 9), kuva LINE (20, 20)-(39, 39), 45, BF 'Tausta, johon kokeilemme GET (20, 20)-(39, 39), alue 'blittien toimintaa. PUT (100, 100), kuva, PSET 'näytetään ensin alkuperäinen kuva... ReTouchGet kuva(), 5, 5, 5 'muokataan hieman - piste keskelle PUT (110, 100), kuva, PSET 'Vóila! PUT (100, 110), alue 'näytetään tausta... 'Piirretään taustaan kuva() sekä normaalisti että käyttäen 'vihreää (2) läpinäkyvänä. 'Huomaa, kopioidaan 0,0:sta 10x10 alue eli koko kuva. BlitGetToGet kuva(), 0, 0, alue(), 0, 0, 10, 10 BlitGetToGetTrans kuva(), 0, 0, alue(), 10, 0, 10, 10, 2 PUT (122, 110), alue 'Ja näytetään lopputulos. Heh.
Khuul!
"Koodia á la Maestro Sqwiik"
Noin se pitäis kirjottaa, jos sillä halutaan tarkoittaa "Koodia Maestro Sqwiikin kera". Opetelkaa ranskaa jumaliste :P
Hups... piti olla alunperin 'by', mutta se vain tuli jostain... Korjasin sen sitten.
Tästä huomaa, että Sqwiik rakastaa aliohjelmia :).
Niitä pitääkin rakastaa. Hieno ohjelma.
Heino.
lainaus:
Heino.
Hieno.
Olisko jossain jotain helppiä, jossa lukisi tietoa tuon getin ottamasta kuvasta?
Aihe on jo aika vanha, joten et voi enää vastata siihen.