Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Loading Bitmaps

Status
Not open for further replies.

PhycoPhreak

Programmer
Joined
Dec 1, 2002
Messages
1
Location
CA
I NEED HELP! I would like to know of a way (if there is one) of loading bitmaps into a qb program. This would make it way easier to create graphics programs. I've tried it with the OPEN "colorpic.bmp" FOR INPUT AS #1 but that doesn't work! Can someone please tell me!
 
i got this prog from the net. its what i use mostly. it loads 16 bit .bmp fiels in qbasic'******16 Color Bmp loader*******

'this Program Loads 16 color Bitmaps
'please type in the filename into the Data$ statement
'you can control the pictures position by using the a% and b% variables
'a% = left to right b% = up or down

SCREEN 12
CLS
DEFINT A-Z

'********************************
Data$ = "" 'ENTER THE FILE NAME

' a% = 100
' b% = 100
'********************************

DEFINT A-Z
DIM byte AS STRING * 1
IF LTRIM$(RTRIM$(Data$)) = "" THEN END
OPEN Data$ FOR BINARY AS #1
IF LOF(1) = 0 THEN
'PRINT "File not found! Press any key"
CLOSE
GOTO lucky
END IF
table$ = INPUT$(54, #1) 'Get the file header (54 bytes)
DIM table&(30) 'Create numerical array for header
DEF SEG = VARSEG(table&(1))
pointer% = VARPTR(table&(1))
'Poke the data from string "table$" into numerical array "table&"
FOR x% = 0 TO 51
POKE pointer% + x%, ASC(MID$(table$, x% + 3, 1))
NEXT
DEF SEG
'Check for valid file type
IF MID$(table$, 1, 2) <> &quot;BM&quot; OR table&(4) <> 40 THEN
PRINT &quot;Not a valid *.BMP file!&quot;: END
END IF
IF table&(8) <> 0 THEN
PRINT &quot;This program will not diplay RLE encoded files&quot;: END
END IF
IF ASC(MID$(table$, 29, 1)) <> 4 THEN
CLOSE
END IF
'Set the video mode for best picture fit
'IF (table&(5) < 321) AND (table&(6) < 201) THEN
' SCREEN 13
'ELSE
'END IF
'LOCATE 14, 1
'PRINT &quot; Image is loading &quot;
thecolors$ = INPUT$(table&(3) - 54, #1) 'Read in pallette info
'Read in Bitmap data and set pixels accordingly
y% = table&(6) 'Put number of vertical pixels into y%
DO
Data$ = INPUT$((((table&(5) - 1) OR 7) + 1) \ 2, #1)
IF (table&(5) \ 2) < LEN(Data$) THEN
linelength% = table&(5) \ 2
ELSE
linelength% = LEN(Data$)
END IF
FOR x% = 1 TO linelength%
pixel% = ASC(MID$(Data$, x%, 1))
PSET (x% * 2 + 1 + a%, y% + b%), pixel% AND 15
PSET (x% * 2 + a%, y% + b%), pixel% \ 16
NEXT
y% = y% - 1
LOOP UNTIL EOF(1)
CLOSE
lucky:

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top