Results 1 to 2 of 2

Thread: Uncompressed 8 bit bitmap reader->

Threaded View

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Feb 2003
    Posts
    928

    Uncompressed 8 bit bitmap reader->

    Hi,

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

    Code:
    ''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.
    Last edited by Peter Swinkels; Dec 28th, 2018 at 06:31 PM. Reason: Canvas now uses 32 bit LONG integer elements.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width