'===========================================================================
' Subject: LOADS 24-BIT BMP FILES            Date: 12-22-98 (21:56)       
' Author:  Yousuf Philips                    Code: QB, QBasic, PDS        
' Origin:  philipz@emirates.net.ae         Packet: GRAPHICS.ABC
'===========================================================================
''''''''''''''''''''''''''''''''''''''''
' Program    : Loads 24-BIT BMP Files  '
' Name       : 24BITBMP Version 0.1    '
' Programmer : Yousuf Philips          '
' Company    : Y P I                   '
' Updated On : 24th of Nov. 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  */'

'/* This program has been created by YPI (Basic Programming Incorporation) */'
'/* as a utility to load 24-BIT BMPs in SCREEN 13.                         */'

'/* We all know it isn't possible to actually load a 24-BIT image into a   */'
'/* 8-BIT graphics mode. What has been done is to extract the RGB of each  */'
'/* pixel color and then search through a given 256 color palette for the  */'
'/* closest color. The default 256 color palette in SCREEN 13 isn't good   */'
'/* enough for the algorithm so a color palette created by Steve Demo was  */'
'/* used and is located in the SUB ChangePalette. If you have a palette    */'
'/* and would like to  try it out on  the algorithm then  place it in the  */'
'/* ChangePalette SUB.  If it is  better then Steve  Demo's palette then   */'
'/* please send it to us and we will use it in the next released version.  */'

'/* If you use any of this code in your program then you must credit YPI.  */'
'/* I would like to give special thanks to Steve Demo for is color palette.*/'
'/* YPI has created an assortment of graphics loaders and players and they */'
'/* can all be found at <http://members.xoom.com/Philipz/>                 */'

DECLARE SUB ChangePalette (Alg%)
DECLARE SUB Open24 (FileName$)

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

CLS
FILES "*.bmp"
PRINT " 1st 24-BIT BMP Loader for Qbasic (ver 0.1) - A YPI Product"
INPUT " Enter File Name - ", FileName$
IF INSTR(FileName$, ".bmp") = 0 THEN FileName$ = FileName$ + ".bmp"
CALL Open24(FileName$)

WHILE INKEY$ <> "": WEND
in$ = INPUT$(1)
SCREEN 2: SCREEN 0
PRINT " 1st 24-BIT BMP Loader for Qbasic (ver 0.1) - By YPI (BASIC Programming Inc.)"
PRINT " Program is Public Domain, (c) Copyrighted by YPI, All Rights Reserved"
PRINT " Programmed By Yousuf Philips in 1998"
PRINT " Send suggestions and comments to philipz85@hotmail.com"
PRINT " If you have a better color palette, please send it to us"
PRINT " Visit the YPI Website at http://members.xoom.com/Philipz/"
Wait$ = INPUT$(1)

DEFINT A-Z
'/* Sub to change the color palette                                        */'
SUB ChangePalette (Alg)

IF Alg = 1 THEN
   '/* An excellent color palette from PALSTUFF.BAS [Graphics.abc|09/1995] */'
   '/* Created by Steve Demo                                               */'
   Change$ = "#####M#M##MMM##M#MM8#MMM88888b8b88bbb88b8bbb8bbb+++"
   Change$ = Change$ + "...222555999===@@@DDDHHHKKKOOOSSSVVVZZZ^^^bbb3##8##"
   Change$ = Change$ + "=##?&&B**E--H11K55N88Q<<T@@XDDZII]NN_SSbYY3+#8-#=/#"
   Change$ = Change$ + "B2#G4#L6#Q9#V;#\>#\B*]F2^K:_OA`TIaXQb]Y33#66#99#<<#"
   Change$ = Change$ + "??#BB#EE#HH#LL#OO#RR#UU#XX#[[#^^#bb##8%#:(#<,#?/#A3"
   Change$ = Change$ + "#C7#F:#H>#KB#ME#OI#RM#TP#WT#YX#\\YbYRbQJbJG^GDZDAWA"
   Change$ = Change$ + ">S>;O;8L85H52E2/A/,=,):)&6&$3#YbbQbbJbbE__A\\=ZZ:VV"
   Change$ = Change$ + "7RR5NN2JJ0FF-BB*>>(::%66#33Y^bQ[bJXbBUb:Rb3Ob+Mb#Jb"
   Change$ = Change$ + "#F\#BV#>P#:J#6D#3?#/9#,3YYbQRbJJbEE_@@\<<Y88V55R33N"
   Change$ = Change$ + "11J..F,,B**>'':%%6##3/@$2B#5D#8F#;H#>J#AL#DN#GP#JR#"
   Change$ = Change$ + "MT#PV#SX#VZ#Y\#]_#bYb`S`^N^\H\ZCZX=XV8VT3UP0QL.MH+I"
   Change$ = Change$ + "D(EA&A<%<7$73#3-+&1-'5/):2+;3+=4,?5-@6-B7.D8/E9/G:0"
   Change$ = Change$ + "I;1J<1L=2N>3O?3Q@4SA5UB6VD8WF;XH>YJAZMD[OG\QJ]SM^VP"
   Change$ = Change$ + "_XS`ZVb]ZZ##X)#W0#U6#T;#S@#RF#PJ#ON#CN#6M#*M##L(#K3"
   Change$ = Change$ + "#K?#KH#FL#>M#5M#-N6#Q>#QD#QL#QQ#NQ#FQ#@Q#9Q#1R#+R##"
   Change$ = Change$ + "bbb"
   FOR Loops = 0 TO 255
      OUT &H3C8, Loops
      OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 1, 1)) - 35
      OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 2, 1)) - 35
      OUT &H3C9, ASC(MID$(Change$, Loops * 3 + 3, 1)) - 35
   NEXT Loops
   Change$ = ""
ELSE
   '/* Randomized color palette */'
   FOR Loops = 1 TO 255
      Blue = INT(RND * 256) \ 4
      Green = INT(RND * 256) \ 4
      Red = INT(RND * 256) \ 4
      OUT &H3C8, Loops
      OUT &H3C9, Red
      OUT &H3C9, Green
      OUT &H3C9, Blue
   NEXT Loops
END IF

END SUB

SUB Open24 (FileName$)

DIM BMPHeader AS BMPHeader
DIM BMPInfoHeader AS WindowsBMPInfoHeader

'/* Open file and check if it is empty                                     */'
OPEN FileName$ FOR BINARY AS #255
IF LOF(255) = 0 THEN
   PRINT " File Is Empty"
   CLOSE
   KILL FileName$
   EXIT SUB
END IF

'/* Extract BMP information from the file                                  */'
GET #255, , BMPHeader
GET #255, , BMPInfoHeader

IF BMPHeader.ValidID <> "BM" THEN
   PRINT " Invalid BMP File"
   EXIT SUB
ELSEIF BMPInfoHeader.BitsPerPixel <> 24 THEN
   PRINT " Not 24-bit Image "
   EXIT SUB
END IF

DIM ColorPalette(255, 3)
DIM PixelArray(2000, 3)
ColorDif = 3

SCREEN 13
'/* Sub which changes the palette */'
'/* Valid values - 1 - Color Palette created by Steve Demo                 */'
'/*                0 - Random Color Palette                                */'
'/* If you want to use your own color palette edit the function, and if you*/'
'/* think you palette works well with the program send it to us.           */'
CALL ChangePalette(1)

'/* Capture the current color palette into an array                        */'
FOR Loops = 0 TO 255
   OUT &H3C7, Loops
   ColorPalette(Loops, 1) = INP(&H3C9)
   ColorPalette(Loops, 2) = INP(&H3C9)
   ColorPalette(Loops, 3) = INP(&H3C9)
NEXT Loops

'/* Calculate the number of bytes per line for the current image           */'
LineExtract$ = SPACE$(BMPInfoHeader.Widthz * 3)
IF (4 - ((BMPInfoHeader.Widthz * 3) MOD 4)) <> 4 THEN
   LineExtract$ = LineExtract$ + SPACE$(4 - ((BMPInfoHeader.Widthz * 3) MOD 4))
END IF
LineExtract& = LEN(LineExtract$)

IF BMPHeader.OffsetOfBitMap = 0 THEN BMPHeader.OffsetOfBitMap = 55

'/* Resize image to fit the Screen                                         */'
ActualHeight! = 199 / (BMPInfoHeader.Heightz - 1)
ActualWidth! = 319 / (BMPInfoHeader.Widthz - 1)
IF ActualHeight! > 1 THEN ActualHeight! = 1
IF ActualWidth! > 1 THEN ActualWidth! = 1
ActualHeight1! = (BMPInfoHeader.Heightz - 1) / 199
ActualWidth1! = (BMPInfoHeader.Widthz - 1) / 319
IF ActualHeight1! < 1 THEN ActualHeight1! = 1
IF ActualWidth1! < 1 THEN ActualWidth1! = 1
WHILE INKEY$ <> "": WEND

FOR YHeight = BMPInfoHeader.Heightz - 1 TO 0 STEP -ActualHeight1!
   '/* Extract only the image lines which will be shown                    */'
   GET #255, BMPHeader.OffsetOfBitMap + ((BMPInfoHeader.Heightz - YHeight - 1) * LineExtract&) + 1, LineExtract$
   FOR XWidth = 0 TO BMPInfoHeader.Widthz - 1 STEP ActualWidth1!
       XWidthPosition = XWidth * 3
       '/* Extract the RGB of each pixel                                   */'
       PixelBlue = ASC(MID$(LineExtract$, XWidthPosition + 1, 1)) \ 4
       PixelGreen = ASC(MID$(LineExtract$, XWidthPosition + 2, 1)) \ 4
       PixelRed = ASC(MID$(LineExtract$, XWidthPosition + 3, 1)) \ 4
       PixelPut = 0: Movement = 0
       '/* Check if the RGB or an RGB close to it are in the color array   */'
       FOR PixelArraySearch = 1 TO ArrayNo
          IF PixelBlue >= PixelArray(PixelArraySearch, 1) - ColorDif AND PixelBlue <= PixelArray(PixelArraySearch, 1) + ColorDif THEN
             IF PixelGreen >= PixelArray(PixelArraySearch, 2) - ColorDif AND PixelGreen <= PixelArray(PixelArraySearch, 2) + ColorDif THEN
                IF PixelRed >= PixelArray(PixelArraySearch, 3) - ColorDif AND PixelRed <= PixelArray(PixelArraySearch, 3) + ColorDif THEN
                   PSET (XWidth * ActualWidth!, YHeight * ActualHeight!), PixelArray(PixelArraySearch, 0)
                   PixelPut = 1
                   EXIT FOR
                END IF
             END IF
          END IF
       NEXT PixelArraySearch
       IF PixelPut = 0 THEN
          '/* Algorithm to find the closest color in the color palette */'
          DO
             FOR Loops = 0 TO 255
                IF PixelBlue >= (ColorPalette(Loops, 3) - Movement) AND PixelBlue <= (ColorPalette(Loops, 3) + Movement) THEN
                   IF PixelGreen >= (ColorPalette(Loops, 2) - Movement) AND PixelGreen <= (ColorPalette(Loops, 2) + Movement) THEN
                      IF PixelRed >= (ColorPalette(Loops, 1) - Movement) AND PixelRed <= (ColorPalette(Loops, 1) + Movement) THEN
                         IF ColorPalette(Loops, 1) = ColorPalette(Loops, 2) AND ColorPalette(Loops, 2) = ColorPalette(Loops, 3) AND Movement > 3 THEN
                            IF PixelBlue = PixelGreen AND PixelBlue = PixelRed THEN
                               PSET (XWidth * ActualWidth!, YHeight * ActualHeight!), Loops
                               IF ArrayNo < 2000 THEN
                                  ArrayNo = ArrayNo + 1
                                  PixelArray(ArrayNo, 1) = PixelBlue
                                  PixelArray(ArrayNo, 2) = PixelGreen
                                  PixelArray(ArrayNo, 3) = PixelRed
                                  PixelArray(ArrayNo, 0) = Loops
                               END IF
                               EXIT DO
                            END IF
                         ELSE
                            PSET (XWidth * ActualWidth!, YHeight * ActualHeight!), Loops
                            IF ArrayNo < 2000 THEN
                            ArrayNo = ArrayNo + 1
                               PixelArray(ArrayNo, 1) = PixelBlue
                               PixelArray(ArrayNo, 2) = PixelGreen
                               PixelArray(ArrayNo, 3) = PixelRed
                               PixelArray(ArrayNo, 0) = Loops
                            END IF
                            EXIT DO
                         END IF
                      END IF
                   END IF
                END IF
             NEXT Loops
             Movement = Movement + 1
          LOOP
       END IF
   NEXT XWidth
NEXT YHeight
CLOSE

END SUB