A long time ago, I wrote a QBasic program that was able to store multiple images (from different sizes) into a single file. I used a rutine called FastLoad from Molnar/Kukalaba (MK Productions) and I adapted their routine to my own needs. That routine used funcitions no longer available on FreeBASIC. So I'm now trying to do the same program with FB but I don't know what's wrong with it. The program stores the image, with all the data I will later need for a game, but the bitmap is stored incomplete. You can test it with any BMP you like.
I can't figure out how to do this in a different way. I know there's 3 warnings (which also I can't see how to implement in other way so I wouldn't have any warning in my compiled program).
Code: Select all
Function loadImage(ByRef file as Const String) As Any Ptr
dim as Long fileHnd = FreeFile(), bWidth, bHeight
Dim as any ptr img
If file = "" Then Exit Function
open file for binary as #fileHnd
get #fileHnd, 19, bWidth
get #fileHnd, 23, bHeight
close #fileHnd
img = imagecreate(bWidth, bHeight, , 32)
bload file, img
If img = 0 Then
Print "image creation failed!"
Sleep : End 1
Else
Return img
end If
End Function
sub storeImage (img_W as integer, img_H as integer, img_PD as integer, img_Ptch as integer, file_H as integer)
for y as integer = 0 to img_H - 1
dim as byte ptr p = img_PD + y * img_Ptch
for x as integer = 0 to img_W - 1
put #file_H, , p[x]
next
next
end sub
sub retrieveImage (img_W as integer, img_H as integer, img_PD as integer, img_Ptch as integer, file_H as integer)
for y as integer = 0 to img_H - 1
dim as byte ptr p = img_PD + y * img_Ptch
for x as integer = 0 to img_W - 1
get #file_H, , p[x]
next
next
end sub
dim as any ptr timage
dim as integer iWidth, iHeight, iBPP, iPitch, iPD, iSize
dim as boolean getresult
dim ID_Char as string * 12
dim Char_actions as integer
dim current_act as integer
dim ani_frames as integer
dim act_sound as integer
screenres 1280, 720, 32
Width 1280 \ 8, 720 \ 16
dim as integer fh = freefile()
open "ninja.pcn" for binary as #fh
get #fh, , ID_Char
get #fh, , Char_actions
get #fh, , current_act
get #fh, , ani_frames
get #fh, , act_sound
get #fh, , iWidth
get #fh, , iHeight
print ID_Char
print Char_actions
print current_act
print ani_frames
print act_sound
print iWidth
print iHeight
timage = imagecreate(iWidth, iHeight, , 32)
getresult = imageinfo (timage, iWidth, iHeight, iBPP, iPitch, iPD, iSize)
retrieveImage (iWidth, iHeight, iPD, iPitch, fh)
close #fh
put (200, 100), timage, pset
'timage = loadImage("ninja.bmp")
'print "OK!"
'put (200, 100), timage, pset
'getresult = imageinfo (timage, iWidth, iHeight, iBPP, iPitch, iPD, iSize)
'print "Width:"; iWidth
'print "Height:"; iHeight
'print "BPPP:"; iBPP
'print "Size:"; iSize
'PRINT "Pitch:"; iPitch
'print "Pixel Data:"; iPD
' ID_Char = "Kunoichi ***"
' Char_actions = 1
' current_act = 1
' ani_frames = 2
' act_sound = 4
' dim as integer fh = freefile()
' open "ninja.pcn" for binary as #fh
' put #fh, , ID_Char
' put #fh, , Char_actions
' put #fh, , current_act
' put #fh, , ani_frames
' put #fh, , act_sound
' put #fh, , iWidth
' put #fh, , iHeight
' storeImage iWidth, iHeight, iPD, iPitch, fh
' close #fh
' print "saved..."
'sleep
'imagedestroy( timage )
END
Thank you in advance.
The FastLOAD routine was this (for QB45, I used it to substitute BLOAD command, because it was faster):
Code: Select all
SUB FastLOAD (FileName$, FileOffset&, DataLength%, DestArray() AS INTEGER)
FF% = FREEFILE
IF FileOffset& = 0 THEN FileOffset& = 1
RemBytes& = DataLength% * 2
BufferSize% = 32766
BufStart% = LBOUND(DestArray)
DEF SEG = VARSEG(DestArray(BufStart%))
Ptr& = VARPTR(DestArray(BufStart%))
LeftBytes& = RemBytes& MOD BufferSize%
OPEN FileName$ FOR BINARY AS #FF%
SEEK #FF%, FileOffset&
IF (LeftBytes& < RemBytes&) THEN
FOR QuickLoad% = 1 TO (DataLength& - LeftBytes&) / BufferSize%
Buffer$ = SPACE$(BufferSize%)
GET #FF%, , Buffer$
FOR x% = 1 TO BufferSize%
POKE Ptr&, ASC(MID$(Buffer$, x%, 1))
Ptr& = Ptr& + 1
NEXT
Buffer$ = ""
RemBytes& = RemBytes& - BufferSize%
NEXT
END IF
IF (LeftBytes& > 0) THEN
Buffer$ = SPACE$(LeftBytes&)
GET #FF%, , Buffer$
FOR x% = 1 TO LeftBytes&
POKE Ptr&, ASC(MID$(Buffer$, x%, 1))
Ptr& = Ptr& + 1
NEXT
Buffer$ = ""
END IF
DEF SEG
CLOSE #FF%
END SUB