'===========================================================================
' Subject: MAKE ANY SIZE .BMP FILE           Date: 03-23-99 (08:41)       
' Author:  Jernej Simoncic                   Code: QB, QBasic, PDS        
' Origin:  jernej.simoncic@guest.arnes.si  Packet: GRAPHICS.ABC
'===========================================================================
DEFINT A-Z
DECLARE SUB MakeBMP (file$, xStart%, yStart%, xEnd%, yEnd%, BPP%)

TYPE BMPheader
     Ident AS STRING * 2     ' "BM"
     Size AS LONG            ' file size (x*y+header+pal)
     Reserved AS LONG        ' junk
     Offset AS LONG          ' header+palette
     HeaderSize AS LONG      ' 40
     xRes AS LONG            ' x resolution
     yRes AS LONG            ' y resolution
     Planes AS INTEGER       ' 1
     BPP AS INTEGER          ' bits per pixel
     Compression AS LONG     ' 0-none/1,2-rle
     ImageSize AS LONG       ' x*y
     PixPerMetreX AS LONG    ' 3790
     PixPerMetreY AS LONG    ' 3780
     UsedColors AS LONG
     ImportantColors AS LONG
END TYPE
DIM SHARED BMPheader AS BMPheader

'----------------------------------------------------------------------------
'Demo: (you can safetly delete this)

SCREEN 12

FOR i% = 0 TO 300
     IF RND AND 1 THEN
          x = INT(RND * 640)
          y = INT(RND * 480)
          c = INT(RND * 16)
          CIRCLE (x, y), INT(RND * 30), c
          IF RND AND 1 THEN
               PAINT (x, y), INT(RND * 16), c
          END IF
     ELSE
          LINE (INT(RND * 640), INT(RND * 480))-(INT(RND * 640), INT(RND * 480)), INT(RND * 16)
     END IF
NEXT

MakeBMP "test.bmp", 20, 20, 619, 459, 4

'
' MakeBMP - make any size Windows 3.0 BMP file
'
' Usage:
'    MakeBMP file$, xStart, yStart, xEnd, yEnd, BPP
'
'    file$     name of file to make
'    xStart    starting x coordinate
'    yStart    starting y coordinate
'    xEnd      ending x coordinate
'    yEnd      ending y coordinate
'    BPP       bits per pixel (8 - 256 colors, 4 - 16 colors, 1 - 2 colors)
'
' Freeware by Jernej Simoncic
'
' Send comments, quetions, etc. to jernej.simoncic@guest.arnes.si or
' ICQ#: 26266467
' You can visit my homepage at: http://www2.arnes.si/~sopjsimo/
'
SUB MakeBMP (file$, xStart, yStart, xEnd, yEnd, BPP)

     IF BPP <> 8 AND BPP <> 4 AND BPP <> 1 THEN EXIT SUB
     IF BPP = 8 THEN
          div = 1
     ELSEIF BPP = 4 THEN
          div = 2
     ELSE
          div = 8
     END IF
    
     BMPheader.xRes = xEnd - xStart + 1
     BMPheader.yRes = yEnd - yStart + 1
     
     BMPheader.Ident = "BM"
     BMPheader.Size = (BMPheader.xRes * BMPheader.yRes) \ div + 54 + 4 * 2 ^ BPP
     BMPheader.Reserved = 0
     BMPheader.Offset = 54 + 4 * 2 ^ BPP
     BMPheader.HeaderSize = 40
     BMPheader.Planes = 1
     BMPheader.BPP = BPP
     BMPheader.Compression = 0
     BMPheader.ImageSize = (BMPheader.xRes * BMPheader.yRes) \ div
     BMPheader.PixPerMetreX = 3790
     BMPheader.PixPerMetreY = 3780
     BMPheader.UsedColors = 0
     BMPheader.ImportantColors = 0

     BMPfile = FREEFILE
     OPEN file$ FOR BINARY AS BMPfile

     PUT BMPfile, , BMPheader

     SELECT CASE BPP
          CASE 8
               pal$ = SPACE$(1024)
               FOR c% = 0 TO 255
                    OUT &H3C7, c%
                    r% = (INP(&H3C9) * 65280) \ 16128
                    g% = (INP(&H3C9) * 65280) \ 16128
                    b% = (INP(&H3C9) * 65280) \ 16128
                    MID$(pal$, c% * 4 + 1, 3) = CHR$(b%) + CHR$(g%) + CHR$(r%)
               NEXT
          CASE 4
               pal$ = SPACE$(64)
               FOR c% = 0 TO 15
                    OUT &H3C7, c%
                    r% = (INP(&H3C9) * 65280) \ 16128
                    g% = (INP(&H3C9) * 65280) \ 16128
                    b% = (INP(&H3C9) * 65280) \ 16128
                    MID$(pal$, c% * 4 + 1, 3) = CHR$(b%) + CHR$(g%) + CHR$(r%)
               NEXT
          CASE 1
               pal$ = SPACE$(8)
               FOR c% = 0 TO 1
                    OUT &H3C7, c%
                    r% = (INP(&H3C9) * 65280) \ 16128
                    g% = (INP(&H3C9) * 65280) \ 16128
                    b% = (INP(&H3C9) * 65280) \ 16128
                    MID$(pal$, c% * 4 + 1, 3) = CHR$(b%) + CHR$(g%) + CHR$(r%)
               NEXT
     END SELECT

     PUT BMPfile, , pal$

     SELECT CASE BPP
          CASE 8
               line$ = SPACE$((INT((BMPheader.xRes - 1) / 4) + 1) * 4)
               FOR y% = yEnd TO yStart STEP -1
                    FOR x% = xStart TO xEnd
                         MID$(line$, x% - xStart + 1, 1) = CHR$(POINT(x%, y%))
                    NEXT
                    LINE (xStart, y%)-(xEnd, y%), 0
                    PUT BMPfile, , line$
               NEXT
          CASE 4
               line$ = SPACE$((INT((BMPheader.xRes - 1) / 8) + 1) * 4)
               FOR y% = yEnd TO yStart STEP -1
                    FOR x% = xStart TO xEnd STEP 2
                         a = POINT(x%, y%) MOD 16
                         b = POINT(x% + 1, y%) MOD 16
                         p% = a * 16 + b
                         MID$(line$, (x% - xStart) / 2 + 1, 1) = CHR$(p%)
                    NEXT
                    LINE (xStart, y%)-(xEnd, y%), 0
                    PUT BMPfile, , line$
               NEXT
          CASE 1
               line$ = SPACE$((INT((BMPheader.xRes - 1) / 32) + 1) * 4)
               DIM Look(7) AS INTEGER
               FOR b% = 0 TO 7
                    Look(7 - b%) = 2 ^ b
               NEXT
               FOR y% = yEnd TO yStart STEP -1
                    FOR x% = xStart TO xEnd STEP 8
                         p% = 0
                         FOR b% = 0 TO 7
                              IF POINT(x% + b%, y%) <> 0 THEN
                                   p% = p% + Look(b%)
                              END IF
                         NEXT
                         MID$(line$, (x% - xStart) / 8 + 1, 1) = CHR$(p%)
                    NEXT
                    LINE (xStart, y%)-(xEnd, y%), 0
                    PUT BMPfile, , line$
               NEXT
     END SELECT

     CLOSE BMPfile
     
END SUB