'=========================================================================== ' Subject: BMP LOAD/SAVE ROUTINES Date: 10-25-98 (19:15) ' Author: Leandro Pardini Code: QB, QBasic, PDS ' Origin: lpardini@cefex.com Packet: GRAPHICS.ABC '=========================================================================== '============================================================================ ' BMP Load/Save routines lpardini@cefex.com '============================================================================ ' These routines can load and write standard Windows uncompressed bitmaps. ' RLE compressed and TrueColor bitmaps are not supported, yet. In the next ' version, I plan to add support to read RLE-4 and RLE-8 bitmaps, and to ' load TrueColor bitmaps in grayscale mode. Suggestions welcome... '============================================================================ ' Speed on QBasic 1.1 - Cyrix 6x86 PR233 32MB RAM Windows 95 Plain DOS ' Load a 640x480x16 color bitmap: 2.35 secs 2.14 secs ' Save a 640x480x16 color bitmap: 7.72 secs 6.59 secs '============================================================================ ' FUNCTION BMPLoad% (File$, PosX%, PosY%) ' Displays a bitmap in screen coordinates PosX% and PosY%. Returns: ' 0 - All OK. ' 1 - Can't find BM signature (File isn't a BMP). ' 2 - File is a RLE compressed bitmap. ' 3 - Unsupported color depth (24-bit). '============================================================================ ' SUB BMPSave (File$, PosX1%, PosY1%, PosX2%, PosY2%, biBitCount%) ' Saves a screen area to a file. biBitCount% can be: ' 1 - Monochrome bitmap. ' 4 - 16 color bitmap. ' 8 - 256 color bitmap. '============================================================================ '$STATIC DEFINT A-Z DECLARE FUNCTION BMPLoad% (File$, PosX%, PosY%) DECLARE SUB BMPSave (File$, PosX1%, PosY1%, PosX2%, PosY2%, biBitCount%) SCREEN 12 a% = BMPLoad%("C:\Windows\Instal~1.bmp", 0, 0) BMPSave "Install2.bmp", 0, 0, 639, 479, 4 FUNCTION BMPLoad% (File$, PosX%, PosY%) OPEN File$ FOR BINARY ACCESS READ AS #1 GET #1, 1, bfType% IF bfType% <> 19778 THEN BMPLoad% = 1: EXIT FUNCTION GET #1, 31, biCompression% IF biCompression% <> 0 THEN BMPLoad% = 2: EXIT FUNCTION GET #1, 29, biBitCount% SELECT CASE biBitCount% CASE 1: bmColors% = 2: bmStep% = 8 CASE 4: bmColors% = 16: bmStep% = 2 CASE 8: bmColors% = 256: bmStep% = 1 CASE ELSE: BMPLoad% = 3: EXIT FUNCTION END SELECT GET #1, 11, bfOffBits% GET #1, 19, biWidth% GET #1, 23, biHeight% SEEK #1, 55 FOR bmPalette% = 0 TO bmColors% - 1 bmBlue% = ASC(INPUT$(1, 1)) \ 4 bmGreen% = ASC(INPUT$(1, 1)) \ 4 bmRed% = ASC(INPUT$(2, 1)) \ 4 OUT &H3C8, bmPalette% OUT &H3C9, bmRed% OUT &H3C9, bmGreen% OUT &H3C9, bmBlue% NEXT bmPalette% LINE (PosX%, PosY%)-(PosX% + biWidth& - 1, PosY% + biHeight& - 1), 0, BF SEEK #1, bfOffBits% + 1 FOR bmPosY% = PosY% + biHeight% - 1 TO PosY% STEP -1 bmBytes% = 0 FOR bmPosX% = PosX% TO PosX% + biWidth% - 1 STEP bmStep% bmBytes% = bmBytes% + 1 bmPixel% = ASC(INPUT$(1, 1)) SELECT CASE bmColors% CASE 2 IF (bmPixel% AND 128) THEN PSET (bmPosX%, bmPosY%), 1 IF (bmPixel% AND 64) THEN PSET (bmPosX% + 1, bmPosY%), 1 IF (bmPixel% AND 32) THEN PSET (bmPosX% + 2, bmPosY%), 1 IF (bmPixel% AND 16) THEN PSET (bmPosX% + 3, bmPosY%), 1 IF (bmPixel% AND 8) THEN PSET (bmPosX% + 4, bmPosY%), 1 IF (bmPixel% AND 4) THEN PSET (bmPosX% + 5, bmPosY%), 1 IF (bmPixel% AND 2) THEN PSET (bmPosX% + 6, bmPosY%), 1 IF (bmPixel% AND 1) THEN PSET (bmPosX% + 7, bmPosY%), 1 CASE 16 IF bmPixel% > 0 THEN PSET (bmPosX%, bmPosY%), bmPixel% \ 16 PSET (bmPosX% + 1, bmPosY%), bmPixel% AND 15 END IF CASE 256 IF bmPixel% > 0 THEN PSET (bmPosX%, bmPosY%), bmPixel% END SELECT NEXT bmPosX% SELECT CASE bmBytes% MOD 4 CASE 1: bmPixel% = ASC(INPUT$(3, 1)) CASE 2: bmPixel% = ASC(INPUT$(2, 1)) CASE 3: bmPixel% = ASC(INPUT$(1, 1)) END SELECT NEXT bmPosY% CLOSE #1 END FUNCTION SUB BMPSave (File$, PosX1%, PosY1%, PosX2%, PosY2%, biBitCount%) biWidth& = PosX2% - PosX1% + 1 biHeight& = PosY2% - PosY1% + 1 OPEN File$ FOR BINARY ACCESS WRITE AS #1 bfType% = 19778: PUT #1, , bfType% bfSize& = 0: PUT #1, , bfSize& bfReserved& = 0: PUT #1, , bfReserved& SELECT CASE biBitCount% CASE 1: bfOffBits& = 62 CASE 4: bfOffBits& = 118 CASE 8: bfOffBits& = 1078 END SELECT PUT #1, , bfOffBits& biSize& = 40: PUT #1, , biSize& PUT #1, , biWidth& PUT #1, , biHeight& biPlanes% = 1: PUT #1, , biPlanes% PUT #1, , biBitCount% biCompression& = 0: PUT #1, , biCompression& biSizeImage& = 0: PUT #1, , biSizeImage& biXPelsPerMeter& = 72: PUT #1, , biXPelsPerMeter& biYPelsPerMeter& = 72: PUT #1, , biYPelsPerMeter& biClrUsed& = 0: PUT #1, , biClrUsed& biClrImportant& = 0: PUT #1, , biClrImportant& SELECT CASE biBitCount% CASE 1: bmColors% = 2: bmStep% = 8 CASE 4: bmColors% = 16: bmStep% = 2 CASE 8: bmColors% = 256: bmStep% = 1 END SELECT FOR bmPalette% = 0 TO bmColors% - 1 OUT &H3C7, bmPalette% bmRed% = INP(&H3C9) * 4 bmGreen% = INP(&H3C9) * 4 bmBlue% = INP(&H3C9) * 4 bmRGB$ = CHR$(bmBlue%) + CHR$(bmGreen%) + CHR$(bmRed%) + CHR$(0) PUT #1, , bmRGB$ NEXT bmPalette% FOR bmPosY% = PosY2% TO PosY1% STEP -1 bmBytes% = 0 FOR bmPosX% = PosX1% TO PosX2% STEP bmStep% bmBytes% = bmBytes% + 1 SELECT CASE bmColors% CASE 2 bmPixel% = 0 IF POINT(bmPosX%, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 128 IF POINT(bmPosX% + 1, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 64 IF POINT(bmPosX% + 2, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 32 IF POINT(bmPosX% + 3, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 16 IF POINT(bmPosX% + 4, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 8 IF POINT(bmPosX% + 5, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 4 IF POINT(bmPosX% + 6, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 2 IF POINT(bmPosX% + 7, bmPosY%) > 0 THEN bmPixel% = bmPixel% + 1 bmPixel$ = CHR$(bmPixel%) CASE 16 bmPixel$ = CHR$((POINT(bmPosX%, bmPosY%) * 16) + POINT(bmPosX% + 1, bmPosY%)) CASE 256 bmPixel$ = CHR$(POINT(bmPosX%, bmPosY%)) END SELECT PUT #1, , bmPixel$ NEXT bmPosX% SELECT CASE bmBytes% MOD 4 CASE 0: bmAlign$ = "" CASE 1: bmAlign$ = CHR$(0) + CHR$(0) + CHR$(0) CASE 2: bmAlign$ = CHR$(0) + CHR$(0) CASE 3: bmAlign$ = CHR$(0) END SELECT PUT #1, , bmAlign$ NEXT bmPosY% CLOSE #1 END SUB