Keskustelu: Koodit: QB: pcx-kuvan lataus

'******************************* PCX-laturi *******************************
'*                     tehnyt: Ville Kumpulainen                          *
'**************************************************************************

TYPE pcxheader
        manufacturer AS STRING * 1
        version AS STRING * 1
        encoding AS STRING * 1
        bpp AS STRING * 1
        x AS INTEGER
        y AS INTEGER
        width AS INTEGER
        height AS INTEGER
        bitshorizontal AS INTEGER
        bitsvertical AS INTEGER
        egapaletti AS STRING * 48
        reserved AS STRING * 1
        planes AS STRING * 1
        bitsperline AS INTEGER
        palettetype AS INTEGER
        padding AS STRING * 58
END TYPE

TYPE vari
        r AS STRING * 1
        g AS STRING * 1
        b AS STRING * 1
END TYPE

DECLARE FUNCTION tuopcxkuva$ (f$, alkux!, alkuy!, loppux!, loppuy!)
DECLARE FUNCTION tuopcxpaletti$ (tiedosto$, mista!, mihin!, valoisuus)

SCREEN 13

' tähän tietysti tiedosto, jonka haluat ladata...
tiedosto$ = "me.pcx"

d$ = tuopcxpaletti$(tiedosto$, 0, 255, 255)
IF d$ <> "OK" THEN PRINT d$
d$ = tuopcxkuva$(tiedosto$, 0, 0, 320, 200)
IF d$ <> "OK" THEN PRINT d$

SLEEP

FUNCTION tuopcxkuva$ (f$, alkux, alkuy, loppux, loppuy)

a = FREEFILE
OPEN f$ FOR BINARY AS a
DIM v AS STRING * 1
DIM pcx AS pcxheader
GET a, , pcx

SELECT CASE pcx.width MOD 4
        CASE 0
                lisa = 0
        CASE 1
                lisa = 3
        CASE 2
                lisa = 2
        CASE 3
                lisa = 1
END SELECT

IF pcx.width > 320 THEN
        tuopcxkuva$ = "Liian leveä kuva"
ELSEIF pcx.height > 200 THEN
        tuopcxkuva$ = "Liian korkea kuva"
ELSEIF ASC(pcx.bpp) <> 8 THEN
        tuopcxkuva$ = "Kuvan täytyy olla 256-värinen"
ELSE
        toistot = 1
        x = pcx.x
        y = pcx.y

        DO
                GET a, , v
                IF ASC(v) >= 192 THEN
                        toistot = ASC(v) - 192
                        GET a, , v
                END IF
                FOR i = 1 TO toistot
                        IF x >= alkux AND x <= loppux AND y >= alkuy AND y <= loppuy THEN
                                PSET (x, y), ASC(v)
                        END IF
                        laskuri = laskuri + 1
                        x = x + 1
                        IF x >= pcx.width + lisa THEN x = 0: y = y + 1
                NEXT i
                toistot = 1

                tuopcxkuva$ = "OK"
                IF x > pcx.width AND y >= pcx.height THEN EXIT DO
                IF laskuri >= 64000 THEN EXIT DO
        LOOP
END IF
CLOSE a
END FUNCTION

FUNCTION tuopcxpaletti$ (tiedosto$, mista, mihin, valoisuus)
IF valoisuus > 255 OR valoisuus < 0 THEN
        tuopcxpaletti$ = "Valoisuus annettu väärin!"
ELSE
        a = FREEFILE
        OPEN tiedosto$ FOR BINARY AS a
        tiedostonkoko = LOF(a)
        SEEK #1, tiedostonkoko - 767
        DIM c AS vari
        FOR i = 0 TO 255
                GET a, , c
                IF i >= mista AND i <= mihin THEN
                        OUT &H3C6, 255
                        OUT &H3C8, i
                        OUT &H3C9, ASC(c.r) / 255 * 63 / 255 * valoisuus
                        OUT &H3C9, ASC(c.g) / 255 * 63 / 255 * valoisuus
                        OUT &H3C9, ASC(c.b) / 255 * 63 / 255 * valoisuus
                END IF
        NEXT i
        tuopcxpaletti$ = "OK"
END IF
END FUNCTION