Error displaying 256 color PCX image program?

[macalwen]

Code: (Select All)

handle& = _NewImage(800, 600, 32)
Screen handle&
Dim palentry As String * 3
Dim rgbpalette(256) As Long


Dim dat As String * 1
Open "c:\shu01.pcx" For Binary As #1
header$ = Space$(128)
Get #1, , header$: Cls
bitsper = Asc(Mid$(header$, 4, 1))
plane = Asc(Mid$(header$, 66, 1))

XRes$ = Mid$(header$, 9, 2)
XRes1$ = Left$(XRes$, 1): XRes2$ = Right$(XRes$, 1)
XRes = Asc(XRes1$) + Asc(XRes2$) * 256 + 1

YRes$ = Mid$(header$, 11, 2)
YRes1$ = Left$(YRes$, 1): YRes2$ = Right$(YRes$, 1)
YRes = Asc(YRes1$) + Asc(YRes2$) * 256 + 1
Dim mqh(800, 800) As Integer
scanline$ = Mid$(header$, 67, 2)
scanline1$ = Left$(scanline$, 1): scanline2$ = Right$(scanline$, 1)
scanline = Asc(scanline1$) + Asc(scanline2$) * 256
If plane = 1 And bitsper = 8 Then

Seek #1, LOF(1) - 767
For i% = 0 To 255
Get #1, , palentry$
R& = Asc(Mid$(palentry$, 1, 1))
G& = Asc(Mid$(palentry$, 2, 1))
B& = Asc(Mid$(palentry$, 3, 1))
rgbpalette&(i%) = _RGB(R&, G&, B&)

Next i%

Seek #1, &H81
c = 1: sum = 1: j% = 1
Do
Get #1, , dat
Select Case Asc(dat)
Case Is < 192
mqh(c, j) = Asc(dat)

c = c + 1
sum = sum + 1

If c = scanline + 1 Then
j% = j% + 1
If j% = YRes + 1 Then Exit Do
c = 1
End If
Case Is > 192 And Asc(dat) <= 255
lps = Asc(dat) - 192
Seek #1, 129 + sum
Get #1, , dat
For a = 1 To lps
mqh(c, j%) = Asc(dat)

c = c + 1

If c = scanline + 1 Then
j% = j% + 1
If j% = YRes + 1 Then Exit Do
c = 1
End If
Next a
sum = sum + 2
End Select
Loop

For i% = 1 To YRes
For j% = 1 To XRes

PSet (j%, i%), rgbpalette&(mqh(j%, i%))
Next j%, i%
Close #1
End If

[bplus]

try 256 for _newimage instead of 32 bit color pallet

[ahenry3068]

I would  convert the PCX Palette to RGBA values and store them in an array.    Then just use the Color Indx value's as an index into the RGBA array to display the image properly in 24/32 bit color mode.

[SMcNeill]

This is all it takes to work for me:

Code: (Select All)

handle& = _NEWIMAGE(800, 600, 32)

SCREEN handle&



image& = _LOADIMAGE("SHU01.PCX", 32)

_PUTIMAGE , image&

[TerryRitchie]

This is all it takes to work for me:

Code: (Select All)

handle& = _NEWIMAGE(800, 600, 32)

SCREEN handle&



image& = _LOADIMAGE("SHU01.PCX", 32)

_PUTIMAGE , image&

I was thinking the same thing.

[a740g]

I wrote this a long time ago when the pcx loader was not a thing in QB64-PE. It's a lot slower than QB64-PE's builtin loader but it should work with most 8bpp and 24bpp pcx files.

Code: (Select All)

$RESIZE:SMOOTH



DEFLNG A-Z

OPTION _EXPLICIT



DIM image AS LONG: image = LoadPCX(_OPENFILEDIALOG$("Select a PCX File", , "*.pcx|*.PCX"))



IF image < -1 THEN

    SCREEN image

    SLEEP

END IF



SYSTEM



' Loads a 256 color (8-bit) or true color (24-bit) PCX image to a QB64 32-bit image buffer

FUNCTION LoadPCX& (filename AS STRING)

    ' By default we assume a failure

    LoadPCX& = -1



    ' Check if the file exists

    IF NOT _FILEEXISTS(filename) THEN EXIT FUNCTION



    ' Attempt to open the file

    DIM fileHandle AS LONG: fileHandle = FREEFILE

    OPEN filename FOR BINARY ACCESS READ AS fileHandle



    ' Sanity check for PCX header

    IF ASC(INPUT$(1, fileHandle)) <> 10 THEN

        CLOSE fileHandle

        EXIT FUNCTION

    END IF

    IF ASC(INPUT$(1, fileHandle)) <> 5 THEN

        CLOSE fileHandle

        EXIT FUNCTION

    END IF

    IF ASC(INPUT$(1, fileHandle)) <> 1 THEN

        CLOSE fileHandle

        EXIT FUNCTION

    END IF



    ' Read the bits per pixel

    DIM bitsPerPixel AS _UNSIGNED _BYTE

    GET fileHandle, , bitsPerPixel

    IF bitsPerPixel <> 8 THEN

        CLOSE fileHandle

        EXIT FUNCTION

    END IF



    ' Read image dimensions

    DIM word AS _UNSIGNED INTEGER

    DIM pcxSizeX AS LONG, pcxSizeY AS LONG

    GET fileHandle, , word: pcxSizeX = -(word)

    GET fileHandle, , word: pcxSizeY = -(word)

    GET fileHandle, , word: pcxSizeX = pcxSizeX + word + 1

    GET fileHandle, , word: pcxSizeY = pcxSizeY + word + 1



    ' Skip DPI values

    GET fileHandle, , word

    GET fileHandle, , word



    ' Read the 16 color palette

    DIM pal(0 TO 255, 0 TO 2) AS _UNSIGNED _BYTE

    DIM c AS _UNSIGNED _BYTE

    FOR c = 0 TO 15

        pal(c, 0) = ASC(INPUT$(1, fileHandle))

        pal(c, 1) = ASC(INPUT$(1, fileHandle))

        pal(c, 2) = ASC(INPUT$(1, fileHandle))

    NEXT



    GET fileHandle, , c ' skip reserved byte



    ' Read the number of color planes

    DIM colorPlanes AS _UNSIGNED _BYTE

    GET fileHandle, , colorPlanes



    DIM bytesPerLine AS _UNSIGNED INTEGER

    GET fileHandle, , bytesPerLine



    ' Skip additional header data

    FOR c = 1 TO 30

        GET fileHandle, , word

    NEXT



    ' Prepare to read image data

    DIM img(0 TO pcxSizeX - 1, 0 TO pcxSizeY - 1, 0 TO 2) AS _UNSIGNED _BYTE

    DIM img8(0 TO pcxSizeX - 1, 0 TO pcxSizeY - 1) AS _UNSIGNED _BYTE

    DIM ch AS _UNSIGNED _BYTE

    DIM AS _UNSIGNED INTEGER x, y

    DIM AS LONG plane, bmp, oldest



    ' Read RLE encoded PCX data

    IF colorPlanes = 1 THEN

        ' 256 color (8-bit) PCX file

        FOR y = 0 TO pcxSizeY - 1

            x = 0

            WHILE x < bytesPerLine

                ch = ASC(INPUT$(1, fileHandle))

                IF (ch AND &HC0) = &HC0 THEN

                    c = ch AND &H3F

                    ch = ASC(INPUT$(1, fileHandle))

                ELSE

                    c = 1

                END IF

                WHILE c > 0

                    IF x < pcxSizeX THEN img8(x, y) = ch

                    x = x + 1

                    c = c - 1

                WEND

            WEND

        NEXT



        ' Read the 256 color palette

        IF ASC(INPUT$(1, fileHandle)) = 12 THEN

            FOR c = 0 TO 255

                pal(c, 0) = ASC(INPUT$(1, fileHandle))

                pal(c, 1) = ASC(INPUT$(1, fileHandle))

                pal(c, 2) = ASC(INPUT$(1, fileHandle))

            NEXT

        END IF



        ' Create the QB64 image buffer

        bmp = _NEWIMAGE(pcxSizeX, pcxSizeY, 32)

        IF bmp = -1 THEN

            CLOSE fileHandle

            EXIT FUNCTION

        END IF



        oldest = _DEST

        _DEST bmp

        FOR y = 0 TO pcxSizeY - 1

            FOR x = 0 TO pcxSizeX - 1

                c = img8(x, y)

                PSET (x, y), _RGB32(pal(c, 0), pal(c, 1), pal(c, 2), 255)

            NEXT

        NEXT

        _DEST oldest



    ELSEIF colorPlanes = 3 THEN

        ' True color (24-bit) PCX file

        FOR y = 0 TO pcxSizeY - 1

            FOR plane = 0 TO 2

                x = 0

                WHILE x < bytesPerLine

                    ch = ASC(INPUT$(1, fileHandle))

                    IF (ch AND &HC0) = &HC0 THEN

                        c = ch AND &H3F

                        ch = ASC(INPUT$(1, fileHandle))

                    ELSE

                        c = 1

                    END IF

                    WHILE c > 0

                        IF x < pcxSizeX THEN img(x, y, plane) = ch

                        x = x + 1

                        c = c - 1

                    WEND

                WEND

            NEXT

        NEXT



        ' Create the QB64 image buffer

        bmp = _NEWIMAGE(pcxSizeX, pcxSizeY, 32)

        IF bmp = -1 THEN

            CLOSE fileHandle

            EXIT FUNCTION

        END IF



        oldest = _DEST

        _DEST bmp

        FOR y = 0 TO pcxSizeY - 1

            FOR x = 0 TO pcxSizeX - 1

                PSET (x, y), _RGB32(img(x, y, 0), img(x, y, 1), img(x, y, 2), 255)

            NEXT

        NEXT

        _DEST oldest

    ELSE

        CLOSE fileHandle

        EXIT FUNCTION

    END IF



    CLOSE fileHandle



    LoadPCX = bmp

END FUNCTION

[Pete]

I ran it using SCREEN 0 and got far better object resolution...

 --------------
|   ^^-^-^^  |
|   O   O   O   |
|   ][   ][   ][   |
 --------------

Pete

[macalwen]

I found the reason why the previous mqh(c,j) should be mqh(c,j%), causing this part of the data to be all 0. Thank you for your replies.

[SMcNeill]

I found the reason why the previous mqh(c,j) should be mqh(c,j%), causing this part of the data to be all 0. Thank you for your replies.

Is there some reason why you can't just use _LoadImage for this?  Just curious.