'===========================================================================
' Subject: SAVE SCREEN 13 AS 8-BIT RLE BMP   Date: 04-23-99 (18:32)       
' Author:  Yousuf Philips                    Code: QB, QBasic, PDS        
' Origin:  philipz@emirates.net.ae         Packet: GRAPHICS.ABC
'===========================================================================
''''''''''''''''''''''''''''''''''''''''''''''''
' Program    : Save Screen 13 as 8-BIT RLE BMP '
' Name       : SAVERLE Version 0.1             '
' Programmer : Yousuf Philips                  '
' Company    : Y P I                           '
' Updated On : 12th of Sept. 1998              '
' Email - [philipz85@hotmail.com]              '
' [http://members.xoom.com/Philipz/]           '
''''''''''''''''''''''''''''''''''''''''''''''''

'/*               Do not edit this file if you distribute it.              */'
'/*  (c) Copyrighted by YPI in 1998 | All Rights Reserved | Public Domain  */'

'/* The Save8BitRleBMP SUB is able to save any portion of screen 13 as a   */'
'/* 8-BIT Windows RLE compressed BMP file.                                 */'
'/* The Save8BitRleBMP SUB was tested on a Pentium 100MHz and it was able  */'
'/* save the whole of screen 13 in 1.97 seconds.                           */'

'/* If you use any of this code in your program then you must credit YPI.  */'

TYPE BMPHeader
   ValidID AS STRING * 2          '/* Must be 'BM'
   SizeOfFile AS LONG             '/* Size of entire file in bytes
   Reserved AS LONG               '/* Four empty bytes
   OffsetOfBitMap AS LONG         '/* The location in the file where the
                                  '   bitmap is located
END TYPE

TYPE WindowsBMPInfoHeader
    SizeOfHeader AS LONG        '/* Size of Information Header
                                ' 40 - Windows | 12 - OS/2 1.x | 64 OS/2 2.x
    Widthz AS LONG              '/* Width of image in pixels
    Heightz AS LONG             '/* Height of image in pixels
    Planes AS INTEGER           '/* Number of Planes. Must be '1'
    BitsPerPixel AS INTEGER     '/* Number of bits per pixel
                                ' Possible values are 1,4,8,16,24,32
    CompressMethod AS LONG      '/* Compression Method
                                ' 0 - Uncompressed
                                ' 1 - 8 Bit RLE Compression
                                ' 2 - 4 Bit RLE Compression
    ImageSizeInBytes AS LONG    '/* Size of image in bytes
    HorizontalResol AS LONG     '/* Horizontal Resolution
    VerticalResol AS LONG       '/* Vertical Resolution
    ColorsUsed AS LONG          '/* Number of Colors used | 0 - All Used
    ImportantColors AS LONG     '/* Number of Important Colors
END TYPE

DECLARE SUB Save8BitRleBMP (FileName$, MinX%, MinY%, MaxX%, MaxY%)
'/* FileName$ - The filename of the file that the saved screen is to be put*/'
'/* MinX - The starting x position                                         */'
'/* MinY - The starting y position                                         */'
'/* MaxX - The ending x position                                           */'
'/* MaxY - The ending y position                                           */'

SCREEN 13
FOR Circles = 1 TO 100
   CIRCLE (RND * 320, RND * 200), RND * 100, RND * 256
NEXT Circles
PRINT " Created By YPI (c) 1998"

t = TIMER
CALL Save8BitRleBMP("bmprle.bmp", 0, 0, 319, 199)
PRINT " Time Taken To Save Screen -"; TIMER - t

DEFINT A-Z
SUB Save8BitRleBMP (FileName$, MinX, MinY, MaxX, MaxY)

OPEN FileName$ FOR BINARY AS #255
IF LOF(255) <> 0 THEN
   CLOSE #255
   KILL FileName$
   OPEN FileName$ FOR BINARY AS #255
END IF

DIM BMPHeader AS BMPHeader
DIM BMPInfoHeader AS WindowsBMPInfoHeader

PUT #255, , BMPHeader

BMPInfoHeader.SizeOfHeader = 40
BMPInfoHeader.Widthz = (MaxX - MinX) + 1
BMPInfoHeader.Heightz = (MaxY - MinY) + 1
BMPInfoHeader.Planes = 1
BMPInfoHeader.BitsPerPixel = 8
BMPInfoHeader.CompressMethod = 1

PUT #255, , BMPInfoHeader

FOR Colors = 0 TO 255
   OUT &H3C7, Colors
   Red$ = CHR$(INP(&H3C9) * 4): Green$ = CHR$(INP(&H3C9) * 4): Blue$ = CHR$(INP(&H3C9) * 4)
   ColorPalette$ = ColorPalette$ + Blue$ + Green$ + Red$ + SPACE$(1)
NEXT Colors
PUT #255, , ColorPalette$

FOR YHeight = MaxY TO MinY STEP -1
   '/* Getting line of bytes */'
   FOR XWidth = MinX TO MaxX
      PixelBytes$ = PixelBytes$ + CHR$(POINT(XWidth, YHeight))
   NEXT
   LINE (MinX, YHeight)-(MaxX, YHeight), 0

   '/* Looping through line of bytes in string to compress */'
   FOR XWidth = 1 TO LEN(PixelBytes$)
      PixelColor$ = MID$(PixelBytes$, XWidth, 1)
      IF PixelColor$ = MID$(PixelBytes$, XWidth + 1, 1) THEN
         SimilarPixels = 2: XWidth = XWidth + 2
         WHILE MID$(PixelBytes$, XWidth, 1) = PixelColor$ AND XWidth < LEN(PixelBytes$) AND SimilarPixels <> 255
            SimilarPixels = SimilarPixels + 1: XWidth = XWidth + 1
         WEND
         PixelBytes2$ = PixelBytes2$ + CHR$(SimilarPixels) + PixelColor$
         XWidth = XWidth - 1
      ELSE
         PixelBytes2$ = PixelBytes2$ + CHR$(1) + PixelColor$
      END IF
   NEXT XWidth
   PixelBytes2$ = PixelBytes2$ + STRING$(2, 0)
   PUT #255, , PixelBytes2$
   PixelBytes$ = "": PixelBytes2$ = ""
NEXT YHeight
EndOfImage$ = CHR$(0) + CHR$(1)
PUT #255, , EndOfImage$

BMPHeader.ValidID = "BM"
BMPHeader.SizeOfFile = LOC(255)
BMPHeader.OffsetOfBitMap = 1078
PUT #255, 1, BMPHeader
CLOSE

END SUB