+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: Petr (https://qb64phoenix.com/forum/forumdisplay.php?fid=52)
+---- Thread: PCX file format (/showthread.php?tid=3470)
Pages:
1
2
RE: PCX file format - Petr - 02-24-2025
(02-17-2025, 08:08 PM)SMcNeill Wrote: http://fileformats.archiveteam.org/wiki/PCX
Transparency
We haven't located any PCX specification that mentions transparency, yet some modern graphics software supports 32-bit RGBA format (bits=8, planes=4). ImageMagick will readily create such files.
The Wikipedia article also suggests a 16-bit RGBA format (bits=4, planes=4).
It will also be created by QB64PE and loaded by QB64PE4.1:So. I assume that _LoadImage does not support PCX in 16 bits in RGBA 4444 mode (so one pixel = 1 _Unsigned Integer) where everything is 4 bits. I assume this because I could not "hit" on a format in 16 bits where the LoadImage 4.1 version would not declare only -1. Well, so we worked on it and also made a loader.
With the second 32bit format it was probably lucky, so it settled in version 4.1 quickly, probably on the third try. Then I went to check in version 4.0 and it really does not load it, so we are in the right place.
But if there is support for the 16bit format in version 4.1, please tell me the bits per pixel, whether it is RGB or RGBA and the bit series (whether 555 or 565 or otherwise) and the number of planes.
PCX16 (+ loader):
Code: (Select All)
' Program: Saving PCX in 16-bit mode – each pixel as a 16-bit value:
' 4 bits for R, 4 bits for G, 4 bits for B, 4 bits for alpha.
' Data is stored in 4 planar layers (R, G, B, A).
'
' RLE encoding is performed according to the PCX standard.
DECLARE SUB SavePCX16_RGBA (imageHandle AS Long, fileName AS String)
DECLARE FUNCTION RLEEncodeLine$ (rawLine AS String)
'-------------------------
' Main program
'-------------------------
Dim image As Long, loaded As Long
image = _LoadImage("6.jpg", 32)
SavePCX16_RGBA image, "out16bitRGBA.pcx"
Cls
loaded = _LoadImage("out16bitRGBA.pcx", 32)
Print "Loadimage return: "; loaded
Print "Using LoadPCX16RGBA for load..."
loaded = LoadPCX16RGBA("out16bitRGBA.pcx")
Screen loaded
Print "loaded image handle: "; loaded
End
'-------------------------
' Subroutine SavePCX16_RGBA
' Saves an image from imageHandle to a file as PCX in 16-bit mode.
' Each pixel is saved as a 16-bit value, where:
' - 4 bits for red (R)
' - 4 bits for green (G)
' - 4 bits for blue (B)
' - 4 bits for alpha (A)
'
' Data is stored in 4 planes - each plane contains 4 bits per pixel.
' Therefore, header(3)=4 (4 bits/pixel) and header(65)=4 (4 planes) are set.
'
' Each plane stores 2 pixels per byte, hence:
' bytesPerLine = (imgWidth / 2) or, if the width is odd, (imgWidth\2)+1.
'-------------------------
Sub SavePCX16_RGBA (imageHandle As Long, fileName As String)
Dim imgWidth As Integer, imgHeight As Integer
imgWidth = _Width(imageHandle)
imgHeight = _Height(imageHandle)
Dim bytesPerLine As Integer
If (imgWidth Mod 2) = 0 Then
bytesPerLine = imgWidth \ 2
Else
bytesPerLine = (imgWidth \ 2) + 1
End If
Dim fileNum As Integer
fileNum = FreeFile
Open fileName For Binary As #fileNum
' --- Creating 128-byte PCX header ---
Dim header(127) As _Unsigned _Byte
Dim i As Integer
For i = 0 To 127
header(i) = 0
Next i
header(0) = &H0A ' PCX identifier
header(1) = 5 ' Version 5
header(2) = 1 ' RLE encoding
header(3) = 4 ' 4 bits per pixel (per plane)
' Borders (Xmin, Ymin, Xmax, Ymax)
header(4) = 0 ' Xmin
header(5) = 0
header(6) = 0 ' Ymin
header(7) = 0
header(8) = (imgWidth - 1) And &HFF
header(9) = ((imgWidth - 1) \ 256) And &HFF
header(10) = (imgHeight - 1) And &HFF
header(11) = ((imgHeight - 1) \ 256) And &HFF
' DPI – we set, for example, 300 DPI
header(12) = 300 Mod 256
header(13) = 300 \ 256
header(14) = 300 Mod 256
header(15) = 300 \ 256
' Bytes 16 to 63 – palette not used in this mode (leave as zeros)
header(64) = 0 ' Reserved
header(65) = 4 ' Number of planes = 4 (R, G, B, A)
header(66) = bytesPerLine And &HFF ' Number of bytes per line for one plane
header(67) = (bytesPerLine \ 256) And &HFF
header(68) = 1 ' PaletteInfo = 1 (color)
' The rest of the header (69 to 127) remains zero.
' Writing header to file
For i = 0 To 127
Put #fileNum, , header(i)
Next i
' --- Processing image data ---
' Data will be stored as 4 planes. For each row, we create 4 "raw" strings:
' rawR (red), rawG (green), rawB (blue), rawA (alpha).
' Each byte stores 2 pixels – high nibble = first pixel, low nibble = second pixel.
Dim rawR As String, rawG As String, rawB As String, rawA As String
Dim x As Integer, y As Integer, poss As Integer
Dim colValue As _Unsigned Long
Dim r4 As _Unsigned _Byte, g4 As _Unsigned _Byte, b4 As _Unsigned _Byte, a4 As _Unsigned _Byte
Dim tempByte As _Unsigned _Byte
Dim oldSrc As Long
oldSrc = _Source
_Source imageHandle
For y = 0 To imgHeight - 1
rawR = String$(bytesPerLine, Chr$(0))
rawG = String$(bytesPerLine, Chr$(0))
rawB = String$(bytesPerLine, Chr$(0))
rawA = String$(bytesPerLine, Chr$(0))
poss = 1
For x = 0 To imgWidth - 1 Step 2
' Processing the first (even) pixel
colValue = Point(x, y)
r4 = (_Red32(colValue) \ 16) And &HF
g4 = (_Green32(colValue) \ 16) And &HF
b4 = (_Blue32(colValue) \ 16) And &HF
a4 = (_Alpha32(colValue) \ 16) And &HF
' In the corresponding byte, store the value in the high nibble
tempByte = r4 * 16
Mid$(rawR, poss, 1) = Chr$(tempByte)
tempByte = g4 * 16
Mid$(rawG, poss, 1) = Chr$(tempByte)
tempByte = b4 * 16
Mid$(rawB, poss, 1) = Chr$(tempByte)
tempByte = a4 * 16
Mid$(rawA, poss, 1) = Chr$(tempByte)
' Processing the second (odd) pixel, if it exists
If x + 1 < imgWidth Then
colValue = Point(x + 1, y)
r4 = (_Red32(colValue) \ 16) And &HF
g4 = (_Green32(colValue) \ 16) And &HF
b4 = (_Blue32(colValue) \ 16) And &HF
a4 = (_Alpha32(colValue) \ 16) And &HF
Else
r4 = 0: g4 = 0: b4 = 0: a4 = 0
End If
' Combine the already stored high nibble with the value of the second pixel (low nibble)
tempByte = Asc(Mid$(rawR, poss, 1)) Or r4
Mid$(rawR, poss, 1) = Chr$(tempByte)
tempByte = Asc(Mid$(rawG, poss, 1)) Or g4
Mid$(rawG, poss, 1) = Chr$(tempByte)
tempByte = Asc(Mid$(rawB, poss, 1)) Or b4
Mid$(rawB, poss, 1) = Chr$(tempByte)
tempByte = Asc(Mid$(rawA, poss, 1)) Or a4
Mid$(rawA, poss, 1) = Chr$(tempByte)
poss = poss + 1
Next x
' RLE encoding and writing each plane for the given row
Dim encodedLine As String
encodedLine = RLEEncodeLine$(rawR)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawG)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawB)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawA)
Put #fileNum, , encodedLine
Next y
_Source oldSrc
Close #fileNum
End Sub
'-------------------------
' Function RLEEncodeLine$
' Performs RLE encoding of the input string according to the PCX specification (max. 63 repetitions)
'-------------------------
Function RLEEncodeLine$ (rawLine As String)
Dim i As Integer, count As Integer, currentByte As Integer
Dim encoded As String
encoded = ""
i = 1
While i <= Len(rawLine)
currentByte = Asc(Mid$(rawLine, i, 1))
count = 1
While (i + count <= Len(rawLine)) And (count < 63)
If Asc(Mid$(rawLine, i + count, 1)) = currentByte Then
count = count + 1
Else
Exit While
End If
Wend
If (count = 1) And (currentByte < 192) Then
encoded = encoded + Chr$(currentByte)
Else
encoded = encoded + Chr$(192 + count) + Chr$(currentByte)
End If
i = i + count
Wend
RLEEncodeLine$ = encoded
End Function
' Main loader function, returns the handle of the loaded image
Function LoadPCX16RGBA& (fileName As String)
Dim fileNum As Integer
fileNum = FreeFile
Open fileName For Binary As #fileNum
' Load the 128-byte header
Dim header(127) As _Unsigned _Byte
Dim i As Integer
For i = 0 To 127
Get #fileNum, , header(i)
Next i
' Determine dimensions from header
Dim width As Integer, height As Integer
width = header(8) + header(9) * 256 + 1
height = header(10) + header(11) * 256 + 1
' Number of bytes per line for one plane
Dim bytesPerLine As Integer
bytesPerLine = header(66) + header(67) * 256
' Create a new image (32-bit, true color)
Dim img As Long
img = _NewImage(width, height, 32)
Dim y As Integer, x As Integer, p As Integer
' Array for storing de-RLE decoded data for each plane
Dim planeData(3) As String
preDest = _Dest
_Dest img
' Processing row by row
For y = 0 To height - 1
' Load data for each of the 4 planes (in the order: R, G, B, A)
For p = 0 To 3
planeData(p) = RLEDecodeLine$(fileNum, bytesPerLine)
Next p
' Iterate through each pixel in the row
For x = 0 To width - 1
Dim byteIndex As Integer, rNibble As Integer, gNibble As Integer, bNibble As Integer, aNibble As Integer
byteIndex = x \ 2 ' Each byte contains 2 pixels
If (x Mod 2) = 0 Then
' Even pixel: value obtained from the high nibble
rNibble = (Asc(Mid$(planeData(0), byteIndex + 1, 1)) And &HF0) \ 16
gNibble = (Asc(Mid$(planeData(1), byteIndex + 1, 1)) And &HF0) \ 16
bNibble = (Asc(Mid$(planeData(2), byteIndex + 1, 1)) And &HF0) \ 16
aNibble = (Asc(Mid$(planeData(3), byteIndex + 1, 1)) And &HF0) \ 16
Else
' Odd pixel: value obtained from the low nibble
rNibble = Asc(Mid$(planeData(0), byteIndex + 1, 1)) And &HF
gNibble = Asc(Mid$(planeData(1), byteIndex + 1, 1)) And &HF
bNibble = Asc(Mid$(planeData(2), byteIndex + 1, 1)) And &HF
aNibble = Asc(Mid$(planeData(3), byteIndex + 1, 1)) And &HF
End If
' Conversion of 4-bit values (0-15) to 8-bit (0-255) (0->0, 15->255)
Dim r8 As Integer, g8 As Integer, b8 As Integer, a8 As Integer
r8 = rNibble * 17
g8 = gNibble * 17
b8 = bNibble * 17
a8 = aNibble * 17
' Set the pixel in the image
PSet (x, y), _RGBA32(r8, g8, b8, a8)
Next x
Next y
Close #fileNum
LoadPCX16RGBA = img
_Dest preDest
End Function
' RLE decoding function reads from fileNum a string of expectedLength bytes after decompression
Function RLEDecodeLine$ (fileNum As Integer, expectedLength As Integer)
Dim outpt As String
outpt = ""
Dim b As _Unsigned _Byte, count As _Unsigned _Byte, value As _Unsigned _Byte
Dim i As Integer
While Len(outpt) < expectedLength
Get #fileNum, , b
If b >= 192 Then
count = b - 192
Get #fileNum, , value
For i = 1 To count
outpt = outpt + Chr$(value)
Next i
Else
outpt = outpt + Chr$(b)
End If
Wend
RLEDecodeLine$ = outpt
End Function
PCX32:
Code: (Select All)
' Program: Saving PCX in 32-bit true color mode (4 planes of 8 bits each)
' The output file will contain 4 planar channels: Red, Green, Blue, Alpha
DECLARE SUB SavePCX32 (imageHandle AS Long, fileName AS String)
DECLARE FUNCTION RLEEncodeLine$ (rawLine AS String)
'-------------------------
' Main program
'-------------------------
Dim image As Long, loaded As Long
image = _LoadImage("6.jpg", 32)
SavePCX32 image, "vystup.pcx"
Cls
loaded = _LoadImage("vystup.pcx", 32)
Print "Loaded image handle: "; loaded
Sleep 1
Screen loaded
End
'-------------------------
' Subroutine SavePCX32
' Saves the image from imageHandle to a file as PCX in 32-bit true color mode
' with 4 planes (R, G, B, A)
'-------------------------
Sub SavePCX32 (imageHandle As Long, fileName As String)
Dim imgWidth As Integer, imgHeight As Integer
imgWidth = _Width(imageHandle)
imgHeight = _Height(imageHandle)
' Number of bytes per line for one plane – each pixel is 1 byte (8 bits)
Dim bytesPerLine As Integer
If (imgWidth Mod 2) = 0 Then
bytesPerLine = imgWidth
Else
bytesPerLine = imgWidth + 1 ' ensure an even number of bytes
End If
' Opening the file for writing
Dim fileNum As Integer
fileNum = FreeFile
Open fileName For Binary As #fileNum
' --- Creating and writing the 128-byte header ---
Dim header(127) As _Unsigned _Byte
Dim i As Integer
For i = 0 To 127
header(i) = 0
Next i
header(0) = &H0A ' PCX identifier
header(1) = 5 ' Version 5
header(2) = 1 ' RLE encoding
header(3) = 8 ' 8 bits per pixel per plane
' Borders (Xmin, Ymin, Xmax, Ymax)
header(4) = 0 ' Xmin
header(5) = 0
header(6) = 0 ' Ymin
header(7) = 0
header(8) = (imgWidth - 1) And &HFF
header(9) = ((imgWidth - 1) \ 256) And &HFF
header(10) = (imgHeight - 1) And &HFF
header(11) = ((imgHeight - 1) \ 256) And &HFF
' DPI (set, for example, 300 DPI)
header(12) = 300 Mod 256
header(13) = 300 \ 256
header(14) = 300 Mod 256
header(15) = 300 \ 256
' Bytes 16 to 63 – the palette is not used in true color, remains zero
header(64) = 0 ' Reserved
header(65) = 4 ' Number of planes = 4 (R, G, B, A)
header(66) = bytesPerLine And &HFF ' Number of bytes per line for one plane
header(67) = (bytesPerLine \ 256) And &HFF
header(68) = 1 ' PaletteInfo = 1 (color) even if the palette is not used
' Bytes 69 to 127 remain zero
' Writing the header to the file
For i = 0 To 127
Put #fileNum, , header(i)
Next i
' --- Processing image data ---
' For each line, we store 4 planes (R, G, B, A). Each plane contains bytesPerLine bytes.
Dim rawR As String, rawG As String, rawB As String, rawA As String
Dim x As Integer, y As Integer, poss As Integer
Dim colValue As _Unsigned Long
Dim rVal As _Unsigned _Byte, gVal As _Unsigned _Byte, bVal As _Unsigned _Byte, aVal As _Unsigned _Byte
Dim oldSrc As Long
oldSrc = _Source
_Source imageHandle
For y = 0 To imgHeight - 1
' Initialize string for each plane with length bytesPerLine
rawR = String$(bytesPerLine, Chr$(0))
rawG = String$(bytesPerLine, Chr$(0))
rawB = String$(bytesPerLine, Chr$(0))
rawA = String$(bytesPerLine, Chr$(0))
poss = 1
For x = 0 To imgWidth - 1
colValue = Point(x, y)
rVal = _Red32(colValue) And &HFF
gVal = _Green32(colValue) And &HFF
bVal = _Blue32(colValue) And &HFF
' If the alpha channel is not available, set the value to 255 (opaque)
aVal = 255 ' optional: _Alpha32(colValue)
Mid$(rawR, poss, 1) = Chr$(rVal)
Mid$(rawG, poss, 1) = Chr$(gVal)
Mid$(rawB, poss, 1) = Chr$(bVal)
Mid$(rawA, poss, 1) = Chr$(aVal)
poss = poss + 1
Next x
' If the width is odd, the rest of the string remains zero (padding)
' RLE encoding and writing of each plane
Dim encodedLine As String
encodedLine = RLEEncodeLine$(rawR)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawG)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawB)
Put #fileNum, , encodedLine
encodedLine = RLEEncodeLine$(rawA)
Put #fileNum, , encodedLine
Next y
_Source oldSrc
Close #fileNum
End Sub
'-------------------------
' Function RLEEncodeLine$
' Performs RLE encoding of the input string according to the PCX specification (max. 63 repetitions)
'-------------------------
Function RLEEncodeLine$ (rawLine As String)
Dim i As Integer, count As Integer, currentByte As Integer
Dim encoded As String
encoded = ""
i = 1
While i <= Len(rawLine)
currentByte = Asc(Mid$(rawLine, i, 1))
count = 1
While (i + count <= Len(rawLine)) And (count < 63)
If Asc(Mid$(rawLine, i + count, 1)) = currentByte Then
count = count + 1
Else
Exit While
End If
Wend
If (count = 1) And (currentByte < 192) Then
encoded = encoded + Chr$(currentByte)
Else
encoded = encoded + Chr$(192 + count) + Chr$(currentByte)
End If
i = i + count
Wend
RLEEncodeLine$ = encoded
End Function
RE: PCX file format - a740g - 02-25-2025
+1The QB64-PE PCX loader does not do 16-bpp yet. I think I could have added it in v4.1. It seems easy. But it also seems really non-standard, so I did not bother.
I'll tinker with ImageMagick later to see if it can generate 16bpp PCX images. I mean if no program in the wild is able to generate such formats, it seems rather useless to add support for it.
Also, there is the question of the RGBA/RGB config - 4444, 565, or 555.
RE: PCX file format - Firerr - 02-27-2025
(02-25-2025, 01:52 AM)a740g Wrote:Have you considered whether it would be worth the effort if programs rarely generate 16bpp PCX images?
The QB64-PE PCX loader does not do 16-bpp yet. I think I could have added it in v4.1. It seems easy. But it also seems really non-standard, so I did not bother.
I'll tinker with ImageMagick later to see if it can generate 16bpp PCX images. I mean if no program in the wild is able to generate such formats, it seems rather useless to add support for it.
Also, there is the question of the RGBA/RGB config - 4444, 565, or 555.
RE: PCX file format - Petr - 03-01-2025
I'm already working on something else (if you look closely at my photo, you'll know what it is), but if you're interested, I can add programs for saving PCX in 555, 565 in 16-bit, including loaders, later.