Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Error displaying 256 color PCX image program?
#1
Code: (Select All)
handle& = _NewImage(800, 600, 32)
Screen handle&
Dim palentry As String * 3
Dim rgbpalette(256) As Long
[Image: test.jpg]

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


Attached Files
.rar   SHU01.rar (Size: 32.78 KB / Downloads: 38)
Reply
#2
try 256 for _newimage instead of 32 bit color pallet
b = b + ...
Reply
#3
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.
Reply
#4
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&
Reply
#5
(07-04-2024, 03:40 PM)SMcNeill Wrote: 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.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply
#6
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
Reply
#7
I ran it using SCREEN 0 and got far better object resolution...

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


Pete
Reply
#8
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.
[Image: test.jpg]
Reply
#9
(07-05-2024, 01:13 PM)macalwen Wrote: 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.
Reply




Users browsing this thread: 2 Guest(s)