QB / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

 Return to Index  

100 lines is EASY. Screen 13 bitmap loader AGAIN, LOL [edit]

January 18 2010 at 5:06 PM
Clippy  (Login burger2227)
R


Response to 100 lines

 
'...............FAST SCREEN 13 BITMAP VIEWER .......................

DEFINT A-Z
REM $INCLUDE: 'QB.BI'
TYPE BmpHeaderType 'offset% Bytes
Id AS STRING * 2 'Should be "BM" 2
Size AS LONG 'Size of the data 4
rr1 AS INTEGER ' 2
rr2 AS INTEGER ' 2
Offset AS LONG 'Position of start of pixel data 4
Horz AS LONG ' 4
PWidth AS LONG 'Image width 4
PDepth AS LONG 'Image height 4
Planes AS INTEGER ' 2
Bpp AS INTEGER 'Should read 8 for a 256 color 2
Compressed AS LONG ' 4
Imagebytes AS LONG 'Width * Height 4
xres AS LONG ' 4
yres AS LONG ' 4
colch AS LONG ' 4
ic AS LONG ' 4
Pal AS STRING * 1024 'Stored as Blue, Green, Red. 54 byte offset
END TYPE
DIM SHARED BMP AS BmpHeaderType 'The BitMaP header definition
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX 'Data IN and OUT
DIM FileHandle AS INTEGER 'DOS Handle to reference BMP file

SCREEN 13 'SCREEN 13 bitmaps only!
INPUT "Enter Bitmap file name: ", file$
file$ = file$ + CHR$(0) 'DOS requires us to append a CHR$(0).
DIM myfile(1 TO LEN(file$)) AS STRING * 1
FOR i = 1 TO LEN(file$)
myfile(i) = MID$(file$, i, 1)
NEXT
InRegs.AX = &H3D00 'AX function Opens the File
InRegs.DS = VARSEG(myfile(1)) 'Segment address of the file name string array
InRegs.DX = VARPTR(myfile(1))
CALL INTERRUPTX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
PRINT "Error opening "; file$
SYSTEM 'abort
END IF
FileHandle = OutRegs.AX ' Save the file handle number if valid file
InRegs.AX = &H3F00 ' Read file function
InRegs.BX = FileHandle:
InRegs.CX = 1078 ' designate file
InRegs.DS = VARSEG(BMP)
InRegs.DX = VARPTR(BMP) ' set bitmap header type
CALL INTERRUPTX(&H21, InRegs, OutRegs) ' get header and palette

Offset% = VARPTR(BMP) + 54 'Pal (pallette) offset's start from header start
OUT &H3C8, 0
FOR i% = 0 TO 255 'ignore pad byte(4) in backward palette
OUT &H3C9, PEEK(Offset% + 2) \ 4 'red
OUT &H3C9, PEEK(Offset% + 1) \ 4 'green
OUT &H3C9, PEEK(Offset%) \ 4 'blue
Offset% = Offset% + 4 'skip padder byte
NEXT

IF BMP.PWidth MOD 4 <> 0 THEN Pad% = 4 - (BMP.PWidth MOD 4) 'padder
iHeight& = BMP.PDepth - 1

Segment% = &HA000 'Address of SCREEN 13 memory
InRegs.AX = &H3F00
InRegs.BX = FileHandle
InRegs.CX = BMP.PWidth + Pad% 'bitmap width + padder

FOR y& = iHeight& TO 0 STEP -1 'place screen from bottom to top
Soffset& = VAL("&H" + HEX$(320& * y&)) 'HEX Hack to get integers over 32767
InRegs.DS = Segment%
InRegs.DX = Soffset&
CALL INTERRUPTX(&H21, InRegs, OutRegs)
NEXT

COLOR 254
InRegs.AX = &H3E00 'AX function closes the file
InRegs.BX = FileHandle 'specify file by handle
InRegs.DS = &HA000 'screen 13 memory segment
InRegs.DX = 0 'clear value
CALL INTERRUPTX(&H21, InRegs, OutRegs) 'close file and clean up
SLEEP
SYSTEM

Only 74 lines! Use the LIBRARY to run this program in QB45 or PDS.
Use 8 BPP (256 color palette) bitmaps only! Program will NOT create new files on bad file entry.

[Edit] Changed integers to long for fullscreen images

Ted


    
This message has been edited by burger2227 on Jan 20, 2010 8:59 PM


 
 Respond to this message   
Responses

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement