'===========================================================================
' Subject: CAPTURE SCREEN 12 TO .BMP         Date: 10-19-97 (21:36)       
' Author:  Yariv Habot                       Code: PB                     
' Origin:  mastic@israelmail.com           Packet: GRAPHICS.ABC
'===========================================================================
' SAVEBMP.BAS - Public domain PowerBASIC sub to capture screen 12
' images to 4/8 bit BMP files (no compression).
'-------------------------------------------------------------------
' Yariv Habot, mastic@israelmail.com.
' Based on Stephen L. Maxson's (smax@isc-durant.com) SAVEBMP8.BAS
' Adjusted for PB 3.2+, probably works on earlier versions as well.
'-------------------------------------------------------------------
' Call the SAVEBMP sub by using:
' SAVEBMP BMPFileName$, Colors%, X1%, Y1%, X2%, Y2%
'
' BMPFileName$ - The .BMP filename. SAVEBMP kills the file if it
'                exists!
' Colors%      - SAVEBMP saves .BMP files in either 8-bit (256
'                colors) or 4-bit (16 colors). Colors% should be
'                16 or 256. Any other value is equal to 256.
' X1%,Y1%      - Coordinates for the upper-left corner. The
'                values must be valid, as SAVEBMP does not check
'                these values for validity.
' X2%,Y2%      - Coordinates for the lower-right corner. The
'                values must be valid, as SAVEBMP does not check
'                these values for validity.
'
' There are differences in speed and output file's size between 4
' and 8 bit .BMP file processing.
'-------------------------------------------------------------------
' The SUB makes use of Coridon Henshaw's GetPalette SUB, so if you
' wish to use SAVEBMP in another program, GetPalette will have to go
' with it.  
'-------------------------------------------------------------------
$STRING 32 'See line 72
DECLARE SUB SAVEBMP (BMPFileName$, Colors%, X1%, Y1%, X2%, Y2%)
DECLARE SUB GETPALETTE (Attr%, Red%, Green%, Blue%)
SCREEN 12

TYPE BMPFileHeader
        FileType as string*2
        Size as long
        Reserved1 as integer
        Reserved2 as integer
        OffBits as long
END TYPE

TYPE BMPInfoHeader
        Size as long
    	ImageWidth as long
        ImageHeight as long
        Planes as integer
        BitCount as integer
        Compression as long
        SizeImage as long
        XPelsPerMeter as long
        YPelsPerMeter as long
        ClrUsed as long
        ClrImportant as long
END TYPE

SUB GETPALETTE (Attr%, Red%, Green%, Blue%)

OUT &H3C7, Attr%
Red% = INP(&H3C9)
Green% = INP(&H3C9)
Blue% = INP(&H3C9)

END SUB

SUB SAVEBMP (BMPFileName$, Colors%, X1%, Y1%, X2%, Y2%)
dim FileHeader as BMPFileHeader
dim InfoHeader as BMPInfoHeader

if Colors%<>16 then
        Colors%=256
        WriteIterations%=5  ' Every 5 lines, Buffer$ reaches 32K, so write
                            ' data to file
else
        WriteIterations%=10 ' Each byte holds 2 pixels, so write every 10
                            ' lines
end if
BMPWidth%=X2%-X1%+1 '  Width and
BMPHeight%=Y2%-Y1%+1 ' height of the image

'Each raster must be a multiple of 4 bytes, this next line takes
'care of 'padded' bytes at the end of rasters of odd-width images-
IF BMPWidth% / 4 <> BMPWidth% \ 4 THEN PadBytes% = 4 - (BMPWidth% MOD 4)

' BITMAPFILEHEADER
FileHeader.FileType="BM" 'BMP format marker
if Colors%=16 then
        FileHeader.Size=((BMPWidth% + PadBytes%) * BMPHeight%)\2 + 118
        FileHeader.OffBits=118 ' 16*4+54
else
        FileHeader.Size=(BMPWidth% + PadBytes%) * BMPHeight% + 1078
        FileHeader.OffBits=1078 '256*4+54
end if

' BITMAPINFOHEADER
InfoHeader.Size=40
InfoHeader.ImageWidth=BMPWidth%
InfoHeader.ImageHeight=BMPHeight%
InfoHeader.Planes=1
if Colors%=16 then
        InfoHeader.BitCount=4
else
        InfoHeader.BitCount=8
end if
InfoHeader.Compression=0 ' No compression
InfoHeader.SizeImage=(BMPWidth%+PadBytes%)*BMPHeight%  ' Image size in bytes
InfoHeader.XPelsPerMeter=0 ' Picture dimensions in pixels per meter
InfoHeader.YPelsPerMeter=0
if Colors%=16 then
        InfoHeader.ClrUsed=16 ' Colors used in picture
        InfoHeader.ClrImportant=16 ' Important colors in picture
else
        InfoHeader.ClrUsed=256 ' Colors used in picture
        InfoHeader.ClrImportant=256 ' Important colors in picture
end if

if dir$(BMPFileName$)<>"" then kill BMPFileName$
open BMPFileName$ for binary as #1
put #1,,FileHeader
put #1,,InfoHeader

'Save palette data-
Buffer$ = ""
for i% = 0 to Colors%-1
  GETPALETTE i%, Red%, Green%, Blue%
  'Palette is saved B, G, R with unused byte trailing-
  Buffer$ = Buffer$ + CHR$(Blue% * 4)
  Buffer$ = Buffer$ + CHR$(Green% * 4)
  Buffer$ = Buffer$ + CHR$(Red% * 4)
  Buffer$ = Buffer$ + CHR$(0)
next i%
put #1,,Buffer$
Buffer$=""

'Save image data-
for i%=(BMPHeight%-1) to 0 step -1 ' scan lines, beginning from bottom
        if Colors%=16 then
                for j%=0 to (BMPWidth%-1) step 2 ' scan columns, 2 pixels per byte
                        Buffer$=Buffer$+CHR$(16*POINT(X1%+j%,Y1%+i%)+POINT(X1%+(j%+1),Y1%+i%))
                next j%
        else
                for j%=0 to (BMPWidth%-1) ' scan columns, 1 pixel per byte
                        Buffer$=Buffer$+CHR$(POINT(X1%+j%,Y1%+i%))
                next j%
        end if
        line (j%,i%)-(0,i%),0 'Wipes screen during scan. Remove if not needed.
        if PadBytes%>0 then
                for j%=1 to PadBytes%
                        Buffer$=Buffer$+CHR$(0)
                next j%
        end if
        if i%/WriteIterations%=i%\WriteIterations% then
                put #1,,Buffer$
                Buffer$=""
        end if
next i%
close #1

END SUB