\ ---------------------------------------------------------------
\ Save File support
\ ---------------------------------------------------------------
4 constant sizeof(RGBQUAD)
14 constant sizeof(BitmapFileHeader)
40 constant sizeof(BitmapInfoHeader)
0 constant biSize
4 constant biWidth
8 constant biHeight
12 constant biPlanes
14 constant biBitCount
16 constant biCompression
20 constant biSizeImage
24 constant biXPelsPerMeter
28 constant biYPelsPerMeter
32 constant biClrUsed
36 constant biClrImportant
: show-BITMAPINFOHEADER { pbmih \ bmih$ -- }
max-path localalloc: bmih$
s" BITMAPINFOHEADER" bmih$ place
s" \nbiSize : " bmih$ +place
pbmih biSize + @ 0 <# #s #> bmih$ +place
s" \nbiWidth : " bmih$ +place
pbmih biWidth + @ 0 <# #s #> bmih$ +place
s" \nbiHeight : " bmih$ +place
pbmih biHeight + @ 0 <# #s #> bmih$ +place
s" \nbiPlanes : " bmih$ +place
pbmih biPlanes + w@ 0 <# #s #> bmih$ +place
s" \nbiBitCount : " bmih$ +place
pbmih biBitcount + w@ 0 <# #s #> bmih$ +place
s" \nbiCompression : " bmih$ +place
pbmih biCompression + @ 0 <# #s #> bmih$ +place
s" \nbiSizeImage : " bmih$ +place
pbmih biSizeImage + @ 0 <# #s #> bmih$ +place
s" \nbiXPelsPerMeter : " bmih$ +place
pbmih biXPelsPerMeter + @ 0 <# #s #> bmih$ +place
s" \nbiYPelsPerMeter : " bmih$ +place
pbmih biYPelsPerMeter + @ 0 <# #s #> bmih$ +place
s" \nbiClrUsed : " bmih$ +place
pbmih biClrUsed + @ 0 <# #s #> bmih$ +place
s" \nbiClrImportant :" bmih$ +place
pbmih biClrImportant + @ 0 <# #s #> bmih$ +place
bmih$ count "message key drop message-off
;
: save-demo-bitmap { nBits \ pbmi lpBits hbm hdcMem hfile nrgbquad BitmapFileHeader save$ -- }
14 LocalAlloc: BitmapFileHeader
max-path LocalAlloc: save$
s" Save Bitmap File: " save$ place
nBits (.) save$ +place
s" Bit" save$ +place
save$ count SetTitle: SaveBitmap
GetHandle: DEMOW Start: SaveBitmap dup c@
IF count save$ place
sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + malloc to pbmi
pbmi sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + erase \ (1) DON'T DELETE THIS LINE
\
sizeof(BitmapInfoHeader) pbmi biSize + !
SCREEN-WIDTH pbmi biWidth + !
SCREEN-HEIGHT pbmi biHeight + !
1 pbmi biPlanes + w!
nBits pbmi biBitCount + w!
nBits
CASE
1 OF BI_RGB 2 to nrgbquad ENDOF
4 OF BI_RLE4 16 to nrgbquad ENDOF \ Could also be BI_RGB for
8 OF BI_RLE8 256 to nrgbquad ENDOF \ uncompressed format
16 OF BI_RGB 0 to nrgbquad ENDOF
24 OF BI_RGB 0 to nrgbquad ENDOF
32 OF BI_RGB 0 to nrgbquad ENDOF
ENDCASE pbmi biCompression + !
\ 0 pbmi biSizeImage + ! NOT NEEDED (1)
\ 0 pbmi biXPelsPerMeter + ! SINCE
\ 0 pbmi biYPelsPerMeter + ! pbmi IS ERASED
\ 0 pbmi biClrUsed + ! ABOVE
\ 0 pbmi biClrImportant + !
SCREEN-HEIGHT
SCREEN-WIDTH
GetHandle: demo-dc
Call CreateCompatibleBitmap to hbm
GetHandle: demo-dc
Call CreateCompatibleDC to hdcMem
hbm hdcMem Call SelectObject drop
SRCCOPY \
0 0 \ y,x origin
GetHandle: demo-dc \ from screen dc
SCREEN-HEIGHT \ height of dest rect
SCREEN-WIDTH \ width of dest rect
0 0 \ y,x dest
hdcMem \ to memory dc
Call BitBlt ?win-error \
DIB_RGB_COLORS
pbmi
NULL
SCREEN-HEIGHT
0
hbm
hdcMem
Call GetDIBits 0= abort" 1st GetDIBits"
\ pbmi show-bitmapinfoheader
pbmi biSizeImage + @ malloc to lpBits
lpBits pbmi biSizeImage + @ erase
DIB_RGB_COLORS
pbmi
lpBits
SCREEN-HEIGHT
0
hbm
hdcMem
Call GetDIBits 0= abort" 2nd GetDIBits"
\ pbmi show-bitmapinfoheader
save$
count
GENERIC_READ GENERIC_WRITE or
create-file abort" CreateFile"
to hfile
0x4d42 BitmapFileHeader w! \ hdr.bfType
sizeof(BitmapFileHeader)
sizeof(BitmapInfoHeader) +
nrgbquad sizeof(RGBQUAD) * +
pbmi biSizeImage + @ +
BitmapFileHeader 2 + ! \ hdr.bfSize
0 BitmapFileHeader 6 + w! \ hdr.bfReserved1
0 BitmapFileHeader 8 + w! \ hdr.bfReserved2
sizeof(BitmapFileHeader)
sizeof(BitmapInfoHeader) +
nrgbquad sizeof(RGBQUAD) * +
BitmapFileHeader 10 + ! \ hdr.bfOffBits
BitmapFileHeader
sizeof(BitmapFileHeader)
hfile write-file drop
pbmi
sizeof(BitmapInfoHeader)
nrgbquad sizeof(RGBQUAD) * +
hfile write-file drop
lpBits
pbmi biSizeImage + @
hfile write-file drop
hfile close-file drop
hdcMem call DeleteDC ?win-error
hbm call DeleteObject ?win-error
lpBits release
pbmi release
ELSE drop
THEN
;