'===========================================================================
' Subject: SAVE SCREEN TO .BMP FILE          Date: 04-08-97 (10:30)       
' Author:  Stephen L. Maxson                 Code: QB, QBasic, PDS        
' Origin:  smax@isc-durant.com             Packet: GRAPHICS.ABC
'===========================================================================
'-------------------------------------------------------------------
'SAVEBMP8.BAS
'-------------------------------------------------------------------
'Stephen L. Maxson
'smax@isc-durant.com
'-------------------------------------------------------------------
'To save an 8-bit .BMP file, just call the SUB, passing the name to
'save as, the X and Y coordinates of the upper-left corner, and the
'X and Y coordinates of the lower-right corner.
'EXAMPLES:
'SaveBMP8 "funky.bmp", 0, 0, 319, 199
'File$ = "groovy.bmp": SaveBMP8 File$, 96, 32, 159, 179
'-------------------------------------------------------------------
'The SUB makes use of Coridon Henshaw's GetPalette SUB, so if you
'wish to use SaveBMP8 in another program, GetPalette will have to go
'with it.  The LongToString$ FUNCTION is also required by SaveBMP8.
'This demo makes use of the SetPalette SUB, but it is not required
'by SaveBMP8.
'-------------------------------------------------------------------
'The SUB takes for granted that you are in screen mode 13 (MCGA/VGA
'320x200x256), and that you are passing it valid values for the
'upper-left and lower-right corners (i.e., the SUB will not check
'to see if you are trying to save an image larger than the screen,
'or if your lower-right corner isn't below and right of your upper-
'left corner).
'-------------------------------------------------------------------
'Public Domain, (ab)use at your own risk.
'-------------------------------------------------------------------

DECLARE SUB SaveBMP8 (Pic$, X1%, Y1%, X2%, Y2%)
DECLARE FUNCTION LongToString$ (L&)
DECLARE SUB GetPalette (Attr%, Red%, Green%, Blue%)
'The SUB below is only required by this demo-
DECLARE SUB SetPalette (Attr%, Red%, Green%, Blue%)
DEFINT A-Z

SCREEN 13
RANDOMIZE TIMER
'Create a random palette-
FOR I = 1 TO 255
  SetPalette I, INT(RND * 64), INT(RND * 64), INT(RND * 64)
NEXT I
'Put some stuff on the screen for us to save-
FOR I = 0 TO 199 STEP 2
  LINE (0, I)-(199, 199 - I), INT(RND * 256)
  LINE (I, 0)-(199 - I, 199), INT(RND * 256)
NEXT I
FOR I = 3 TO 96 STEP 3
  CIRCLE (99, 99), I, INT(RND * 256), , , 1
NEXT I

SaveBMP8 "TEST.BMP", 32, 32, 128, 128

BEEP
DO
LOOP UNTIL INKEY$ <> ""
SCREEN 0, 0, 0
WIDTH 80

END

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

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

END SUB

FUNCTION LongToString$ (L&)

B4% = L& \ 16777216
L& = L& - B4% * 16777216
B3% = L& \ 65536
L& = L& - B3% * 65536
B2% = L& \ 256
L& = L& - B2% * 256
B1% = L&
LongToString$ = CHR$(B1%) + CHR$(B2%) + CHR$(B3%) + CHR$(B4%)

END FUNCTION

SUB SaveBMP8 (Pic$, X1%, Y1%, X2%, Y2%)

'Calculate width and height of image-
BMPWidth% = X2% - X1% + 1
BMPHeight% = Y2% - Y1% + 1
'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)
OPEN Pic$ FOR BINARY AS #1
'General Picture Information-
'  BMP format marker-
Buffer$ = "BM"
'  File size minus header-
L& = (BMPWidth% + PadBytes%) * BMPHeight% + 1078
Buffer$ = Buffer$ + LongToString$(L&)
'  Reserved 1-
Buffer$ = Buffer$ + CHR$(0) + CHR$(0)
'  Reserved 2-
Buffer$ = Buffer$ + CHR$(0) + CHR$(0)
'  Number of bytes offset to picture data-
Buffer$ = Buffer$ + LongToString$(1078)
'Information Header-
'  Size of information header-
Buffer$ = Buffer$ + LongToString$(40)
'  Picture width in pixels-
L& = BMPWidth%
Buffer$ = Buffer$ + LongToString$(L&)
'  Picture height in pixels-
L& = BMPHeight%
Buffer$ = Buffer$ + LongToString$(L&)
'  Number of planes-
Buffer$ = Buffer$ + CHR$(1) + CHR$(0)
'  Bits per pixel-
Buffer$ = Buffer$ + CHR$(8) + CHR$(0)
'  Compression-
Buffer$ = Buffer$ + LongToString$(0)
'  Image size in bytes-
L& = (BMPWidth% + PadBytes%) * BMPHeight%
Buffer$ = Buffer$ + LongToString$(L&)
'  Picture width in pixels per meter-
Buffer$ = Buffer$ + LongToString$(0)
'  Picture height in pixels per meter-
Buffer$ = Buffer$ + LongToString$(0)
'  Colors used in picture-
Buffer$ = Buffer$ + LongToString$(256)
'  Number of important colors-
Buffer$ = Buffer$ + LongToString$(256)
PUT #1, 1, Buffer$
'Save palette data-
Buffer$ = ""
FOR I% = 0 TO 255
  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$
'Save image data-
FOR I% = (BMPHeight% - 1) TO 0 STEP -1
  Buffer$ = ""
  FOR J% = 0 TO (BMPWidth% - 1)
    Buffer$ = Buffer$ + CHR$(POINT(X1% + J%, Y1% + I%))
  NEXT J%
  IF PadBytes% > 0 THEN
    FOR J% = 1 TO PadBytes%
      Buffer$ = Buffer$ + CHR$(0)
    NEXT J%
  END IF
  PUT #1, , Buffer$
NEXT I%
'Put a fork in it, it's done-
CLOSE #1

END SUB

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

OUT &H3C7, Attr%
OUT &H3C8, Attr%
OUT &H3C9, Red%
OUT &H3C9, Green%
OUT &H3C9, Blue%

END SUB