07-04-2024, 05:05 PM
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