Remade your EightBit bitmap SUB to work in QB64 32 bit Bob.

Bob I always liked your bitmap creators for screenshots so I updated it to work in 32 bit. The old one was very limited without 32 bit colors.

Hope you like it. It uses image handles from _LOADIMAGE or Screen Pages from _NEWIMAGE.

A typical Call:

x2% = (_WIDTH(bmp&) - 1)
y2% = (_HEIGHT(bmp&) - 1)

EightBit 0, 0, x2%, y2%, bmp&, "BobSave.bmp"

Ted


SUB ThirtyTwoBIT (x1%, y1%, x2%, y2%, image&, Filename$)
DIM Colors8%(255)
IF x1% > x2% THEN SWAP x1%, x2%
IF y1% > y2% THEN SWAP y1%, y2%

_SOURCE image&
pixelbytes& = _PIXELSIZE(image&)
IF pixelbytes& = 0 THEN BEEP: EXIT SUB 'no text screens

FileType$ = "BM"
QB64$ = "QB64" 'free advertiising in reserved space
IF pixelbytes& = 1 THEN OffsetBITS& = 1078 ELSE OffsetBITS& = 54 'no palette in 24 bit
InfoHEADER& = 40
PictureWidth& = (x2% - x1%) + 1
PictureDepth& = (y2% - y1%) + 1
NumPLANES% = 1
IF pixelbytes& = 1 THEN BPP% = 8 ELSE BPP% = 24
Compression& = 0
WidthPELS& = 3780
DepthPELS& = 3780
IF pixelbytes& = 1 THEN NumColors& = 256

IF (PictureWidth& AND 3) THEN ZeroPAD$ = SPACE$(4 - (PictureWidth& AND 3))

ImageSize& = (PictureWidth& + LEN(ZeroPAD$)) * PictureDepth&
FileSize& = ImageSIZE& + OffsetBITS&

OPEN Filename$ FOR BINARY AS #1

PUT #1, , FileType$
PUT #1, , FileSize&
PUT #1, , QB64$
PUT #1, , OffsetBITS&
PUT #1, , InfoHEADER&
PUT #1, , PictureWidth&
PUT #1, , PictureDepth&
PUT #1, , NumPLANES%
PUT #1, , BPP%
PUT #1, , Compression&
PUT #1, , ImageSize&
PUT #1, , WidthPELS&
PUT #1, , DepthPELS&
PUT #1, , NumColors&
PUT #1, , SigColors& '51 offset

IF pixelbytes& = 1 THEN '4 or 8 BPP
u$ = CHR$(0)
FOR c& = 0 TO 255 'PUT as BGR order colors
cv& = _PALETTECOLOR(c&, image&)
Colr$ = CHR$(_BLUE32(cv&))
PUT #1, , Colr$
Colr$ = CHR$(_GREEN32(cv&))
PUT #1, , Colr$
Colr$ = CHR$(_RED32(cv&))
PUT #1, , Colr$
PUT #1, , u$ 'Unused byte
NEXT
END IF

FOR y% = y2% TO y1% STEP -1 'place bottom up
FOR x% = x1% TO x2%
c& = POINT(x%, y%)
IF pixelbytes& = 1 THEN
a$ = CHR$(c&)
Colors8%(ASC(a$)) = 1
ELSE : a$ = LEFT$(MKL$(c&), 3)
END IF
PUT #1, , a$
NEXT
PUT #1, , ZeroPAD$
NEXT
FOR n = 0 TO 255
IF Colors8%(n) = 1 THEN SigColors& = SigColors& + 1
NEXT n
PUT #1, 51, SigColors&
CLOSE #1
END SUB