Uncompressed 8 bit bitmap reader->

[Peter Swinkels]

Hi,

Feeling like playing with Quick Basic I extended and improved a bitmap reader I wrote a long time ago:

''256 Color Bitmap Reader add-on, by: Peter Swinkels.
DEFINT A-Z
DECLARE FUNCTION OpenBinary (FileName$)
DECLARE SUB DisplayBitmap (FileH, XOffset, YOffset, SCREENWIDTH, SCREENHEIGHT, ImageWidth AS LONG, ImageHeight AS LONG)
DECLARE SUB Main ()
DECLARE SUB SetPalette (FileH)

CALL Main

SUB DisplayBitmap (FileH, XOffset, YOffset, SCREENWIDTH, SCREENHEIGHT, ImageWidth AS LONG, ImageHeight AS LONG)
CONST BITMAP = 1078
CONST DIMENSIONS = 19
DIM Canvas(16000) AS LONG
DIM Position AS LONG
DIM Row$, x, y
STATIC Padding

 IF ImageWidth = 0 AND ImageHeight = 0 THEN
  SEEK FileH, DIMENSIONS
  ImageWidth = CVL(INPUT$(4, FileH))
  ImageHeight = CVL(INPUT$(4, FileH))
  IF SCREENHEIGHT > ImageHeight THEN SCREENHEIGHT = ImageHeight
  Padding = ((LOF(FileH) - BITMAP) / ImageHeight) - ImageWidth
 END IF

 Position = (LOF(FileH) - ((ImageWidth + Padding) * (YOffset + SCREENHEIGHT)))
 IF Position > BITMAP THEN SEEK FileH, Position ELSE SEEK FileH, BITMAP
 Canvas(0) = &HC80A00
 FOR y = SCREENHEIGHT - 1 TO 0 STEP -1
  IF Position > 0 AND LOC(FileH) < LOF(FileH) THEN
   Row$ = INPUT$(ImageWidth + Padding, FileH)
   FOR x = 0 TO SCREENWIDTH - 1 STEP 4
    IF x + XOffset < ImageWidth AND y + YOffset < ImageHeight THEN
     Canvas((((SCREENWIDTH / 4) * y) + (x / 4)) + 1) = CVL(MID$(Row$, x + XOffset + 1, 4))
    END IF
   NEXT x
  END IF
  Position = Position + (ImageWidth + Padding)
 NEXT y
 PUT (0, 0), Canvas
END SUB

SUB Main
CONST SCREENHEIGHT = 200
CONST SCREENWIDTH = 320
DIM ImageHeight AS LONG
DIM ImageWidth AS LONG
DIM FileH, FileName$, Key$, x, y

 SCREEN 0: WIDTH 40: WIDTH 80, 25: COLOR 7, 0: CLS
 COLOR 0, 7: PRINT " BITMAP FILES: " + SPACE$(65)
 COLOR 7, 0: FILES "*.bmp"
 PRINT STRING$(80, "=")
 LINE INPUT "SPECIFY BITMAP: ", FileName$
 IF LTRIM$(RTRIM$(FileName$)) = "" THEN EXIT SUB
 SCREEN 13
 FileH = OpenBinary(FileName$)
 SetPalette FileH
 x = 0
 y = 0
 DO
  CLS
  DisplayBitmap FileH, x, y, SCREENWIDTH, SCREENHEIGHT, ImageWidth, ImageHeight
  DO
   Key$ = INKEY$
  LOOP WHILE Key$ = ""
  SELECT CASE Key$
   CASE CHR$(0) + "H"
    y = y - (SCREENHEIGHT / 4)
   CASE CHR$(0) + "P"
    y = y + (SCREENHEIGHT / 4)
   CASE CHR$(0) + "K"
    x = x - (SCREENWIDTH / 4)
   CASE CHR$(0) + "M"
    x = x + (SCREENHEIGHT / 4)
   CASE "1"
    x = x - SCREENWIDTH
    y = y + SCREENHEIGHT
   CASE "2"
    y = y + SCREENHEIGHT
   CASE "3"
    x = x + SCREENWIDTH
    y = y + SCREENHEIGHT
   CASE "4"
    x = x - SCREENWIDTH
   CASE "6"
    x = x + SCREENWIDTH
   CASE "7"
    x = x - SCREENWIDTH
    y = y - SCREENHEIGHT
   CASE "8"
    y = y - SCREENHEIGHT
   CASE "9"
    x = x + SCREENWIDTH
    y = y - SCREENHEIGHT
   CASE "i", "I"
    PALETTE: CLS
    PRINT USING "X: ####"; x
    PRINT USING "Y: ####"; y
    PRINT USING "Width:  ####"; ImageWidth
    PRINT USING "Height: #### "; ImageHeight
    DO: LOOP WHILE INKEY$ = ""
    SetPalette FileH
   CASE CHR$(27)
    EXIT DO
  END SELECT
  IF x < 0 THEN x = 0
  IF y < 0 THEN y = 0
 LOOP
 CLOSE FileH
END SUB

FUNCTION OpenBinary (FileName$)
DIM FileH

 FileH = FREEFILE
 OPEN FileName$ FOR INPUT AS FileH: CLOSE FileH
 OPEN FileName$ FOR BINARY AS FileH

OpenBinary = FileH
END FUNCTION

SUB SetPalette (FileH)
CONST COLORS = 55
DIM Blue AS LONG
DIM Green AS LONG
DIM Red AS LONG
DIM ColorIndex, Null$

 SEEK FileH, COLORS
 FOR ColorIndex = 0 TO 255
  Blue = (ASC(INPUT$(1, FileH)) \ &H4) * &H10000
  Green = (ASC(INPUT$(1, FileH)) \ &H4) * &H100
  Red = ASC(INPUT$(1, FileH)) \ &H4
  PALETTE ColorIndex, Red OR Green OR Blue
  Null$ = INPUT$(1, FileH)
 NEXT ColorIndex
END SUB

The program is meant to run in low resolution VGA (screen mode 13) and supports scrolling through the use of the arrow keys/numeric keypad. A few optimizations I made are:
1. Reading an entire row of pixels at a time instead of one at a time. Apparently calling the INPUT$ function once to read several bytes is faster than individual calls. On the downside you have to be careful not to try to read to much due to datatype/memory limitations.
2. The program now focusses on only processing the portion of the image that will fit on the screen instead of blindly drawing outside the screen borders.
3. The image is drawn to a buffer (an array called Canvas) which is then drawn using the PUT graphics statement. This appears to be slightly faster than separate calls to the PSET statement. At least the image appears all at once instead of slowly appearing line by line.
4. Added scrolling - made possible by the DisplayBitmap procedure now accepting x/y offset values.

This program likely doesn't have much practical value, but it was entertaining to squeeze as much as possible out of such an old programming language as Quick Basic. :-) The program should work in Qbasic/Quick Basic/Visual Basic for DOS and probably Turbo/Power Basic as well.