11-28-2005, 04:24 AM
i found a bmp loading program and this is the source
although it doesnt seem to work, wats wrong with it
Code:
DECLARE SUB ErrorCheck (DidLoad%)
DECLARE SUB PalSwitch (Pal$, ClearPal%)
DECLARE FUNCTION LoadBmp% (File$, ToSeg%, ToOff%, BmpX%, BmpY%, SwitchPal%, MyPal$)
DEFINT A-Z
SCREEN 13
CONST True = -1, False = 0
' Loads up to a 320x200x256 BMP, EXTREMELY fast.
' I don't think it could be much faster unless you used ASM.
' If calling LoadBmp() and setting SwitchPal to False
' Pal$ will contain the BMP's palette which you can then set later
' with the PalSwitch routine, If you have no further need for the pal
' after the PalSwitch I'd set ClearPal to true on the PalSwitch call
' as it will remove the palette from the string and save sum string space.
' The LoadBmp() function will return error codes if anything is wrong
' So it is suggested to call ErrorCheck afterwards to make sure everything
' was ok, this could save you some trouble.
Segment = &HA000
Offset = 0
X = 0
Y = 0
DidLoad = LoadBmp("C:\qbasic\uqb.bmp", Segment, Offset, X, Y, True, Pal$)
ErrorCheck DidLoad
A$ = INPUT$(1)
SUB ErrorCheck (DidLoad)
IF DidLoad = 0 THEN EXIT SUB
IF DidLoad THEN
PRINT "ERROR LOADING BMP"
PRINT "ERROR:";
SELECT CASE DidLoad
CASE 1: PRINT "Header isn't valid": END
CASE 2: PRINT "The width is to large": END
CASE 3: PRINT "The height is to large": END
END SELECT
END IF
END SUB
FUNCTION LoadBmp (File$, ToSeg, ToOff, BmpX, BmpY, SwitchPal, MyPal$)
F = FREEFILE
OPEN File$ FOR BINARY AS #F
Head$ = " "
GET #F, , Head$
IF Head$ <> "BM" THEN
LoadBmp = 1
CLOSE #F
EXIT FUNCTION
END IF
BmpXSize$ = SPACE$(4)
BmpYSize$ = SPACE$(4)
GET #F, 19, BmpXSize$
GET #F, 23, BmpYSize$
XSize = CVL(BmpXSize$)
YSize = CVL(BmpYSize$)
IF XSize > 319 THEN
LoadBmp = 2
CLOSE #F
EXIT FUNCTION
END IF
IF YSize > 199 THEN
LoadBmp = 3
CLOSE #F
EXIT FUNCTION
END IF
Pal$ = SPACE$(1024)
GET #F, 55, Pal$
IF SwitchPal = 0 THEN MyPal$ = Pal$
IF SwitchPal THEN
OUT 968, 0
FOR I = 0 TO 255
OUT 969, ASC(MID$(Pal$, I * 4 + 3, 1)) \ 4
OUT 969, ASC(MID$(Pal$, I * 4 + 2, 1)) \ 4
OUT 969, ASC(MID$(Pal$, I * 4 + 1, 1)) \ 4
NEXT
END IF
BmpData$ = SPACE$(XSize + 1)
DEF SEG = ToSeg
Ys& = (YSize + BmpY) * 320&
FOR Iy = YSize TO 1 STEP -1
GET #F, , BmpData$
FOR Ix = 1 TO XSize
Clr = ASC(MID$(BmpData$, Ix, 1))
POKE Ys& + ((Ix + BmpX) + ToOff), Clr
NEXT
Ys& = Ys& - 320
NEXT
CLOSE #F
LoadBmp = 0
END FUNCTION
SUB PalSwitch (Pal$, ClearPal)
OUT 968, 0
FOR I = 0 TO 255
OUT 969, ASC(MID$(Pal$, I * 4 + 3, 1)) \ 4
OUT 969, ASC(MID$(Pal$, I * 4 + 2, 1)) \ 4
OUT 969, ASC(MID$(Pal$, I * 4 + 1, 1)) \ 4
NEXT
IF ClearPal THEN Pal$ = ""
END SUBalthough it doesnt seem to work, wats wrong with it
