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 strongm 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
Dec 1, 2002
1
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