Storing multiple images in a single file...

New to FreeBASIC? Post your questions here.
Post Reply
PublioMaro_Virgilivs
Posts: 19
Joined: Nov 23, 2020 16:45
Contact:

Storing multiple images in a single file...

Post by PublioMaro_Virgilivs »

Hi guys!

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
The most notorious warning is that I'm passing scalar as pointer. I know this could be easier just grabbing bitmaps from file straight to the memory, but I have so many animations and I would like my game just have a file called character_X.anims with all the animations for that character X instead a lot of files scattered in different directories and many filenames for the same goal. I've been searching in the forum to see if I can find an answer, but I give up my self.

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
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Storing multiple images in a single file...

Post by paul doe »

Code: Select all

#include once "file.bi"
#include once "fbgfx.bi"

function loadBMP( byref path as const string ) as Fb.Image ptr
  #define BM_WINDOWS &h4D42
  
  type BITMAPFILEHEADER field = 1
    as ushort id
    as ulong size
    as ubyte reserved( 0 to 3 )
    as ulong offset
  end type
  
  type BITMAPINFOHEADER field = 1
    as ulong size
    as long width
    as long height
    as ushort planes
    as ushort bpp
    as ulong compression_method
    as ulong image_size
    as ulong h_res
    as ulong v_res
    as ulong color_palette_num
    as ulong colors_used
  end type
  
  dim as any ptr img = 0
  
  if( fileExists( path ) ) then
    dim as BITMAPFILEHEADER header 
    dim as BITMAPINFOHEADER info
    
    dim as long f = freeFile()
    
    open path for binary as f
      get #f, , header
      get #f, sizeOf( header ) + 1, info
    close( f )
    
    '' Check if the file is indeed a Windows bitmap
    if( header.id = BM_WINDOWS ) then
      img = imageCreate( info.width, info.height )
      bload( path, img )
    end if
  end if
  
  return( img )
end function

'' Saves an image to a binary file at the current position
sub saveImage( hFile as long, img as Fb.Image ptr )
  put #hFile, , img->width
  put #hFile, , img->height
  put #hFile, , *( cast( ubyte ptr, img ) + sizeof( Fb.Image ) ), img->pitch * img->height
end sub

'' Loads an image from a binary file at the current position
function loadImage( hFile as long ) as Fb.Image ptr
  dim as ulong w, h
  
  get #hFile, , w
  get #hFile, , h
  
  dim as Fb.Image ptr img = imageCreate( w, h )
  
  get #hFile, , *( cast( ubyte ptr, img ) + sizeof( Fb.Image ) ), img->pitch * img->height
  
  return( img )
end function
Those two functions (along with a less naïve version of the function to load a bitmap from file) can be used to do what you want. They save the width and the height of an image, and the data for the image in binary format. Now, they save a single image, but you can use them to build up whatever you need, since they accept the handle of the file you're saving/loading from.

EDIT: I had coded this before and storing the pitch is not really needed. Corrected.
Last edited by paul doe on Apr 23, 2021 2:14, edited 1 time in total.
PublioMaro_Virgilivs
Posts: 19
Joined: Nov 23, 2020 16:45
Contact:

Re: Storing multiple images in a single file...

Post by PublioMaro_Virgilivs »

Wow that's amazing! Thank you @paul doe!

I don't understand at all the code you posted (I'm just a beginner), but now I'm working with it trying to understand it. I'll get back as soon as I finish.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Storing multiple images in a single file...

Post by paul doe »

Say:

Code: Select all

sub saveImages( hFile as long, images() as Fb.Image ptr )
  dim as long imageCount = ( ubound( images ) - lbound( images ) ) + 1
  
  '' Number of images to save
  put #hFile, , imageCount
  
  '' Save each image
  for i as integer = 0 to imageCount - 1
    saveImage( hFile, images( i ) )
  next
end sub

sub loadImages( hFile as long, images() as Fb.Image ptr )
  dim as long imageCount
  
  get #hFile, , imageCount
  
  redim images( 0 to imageCount - 1 )
  
  for i as integer = 0 to imageCount - 1
    images( i ) = loadImage( hFile )
  next
end sub
That would save/load an array of images to a file. Then, you can load them simply by doing:

Code: Select all

screenRes( 800, 600, 32 )

dim as Fb.Image ptr images()

dim as long f = freeFile()

'' foo2.bin is a file saved by the saveImages() function
open "foo2.bin" for binary access read as f
  loadImages( f, images() )
close( f )

'' Display them
dim as integer x = 0

for i as integer = 0 to ubound( images )
  put( x, 100 ), images( i ), pset
  x += images( i )->width
next

sleep()

for i as integer = 0 to ubound( images )
  imageDestroy( images( i ) )
next
I hope that's useful to you. Cheers.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Storing multiple images in a single file...

Post by paul doe »

PublioMaro_Virgilivs wrote:...
I don't understand at all the code you posted (I'm just a beginner), but now I'm working with it trying to understand it. I'll get back as soon as I finish.
Sure. Or you can go to the FreeBasic Discord server. I'm usually there so you can ask me anything in real time ;)
PublioMaro_Virgilivs
Posts: 19
Joined: Nov 23, 2020 16:45
Contact:

Re: Storing multiple images in a single file...

Post by PublioMaro_Virgilivs »

paul doe wrote:
PublioMaro_Virgilivs wrote:...
I don't understand at all the code you posted (I'm just a beginner), but now I'm working with it trying to understand it. I'll get back as soon as I finish.
Sure. Or you can go to the FreeBasic Discord server. I'm usually there so you can ask me anything in real time ;)
Thank you Paul Doe. Still working. I hope to understand code as you do. Very kind, thank you.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Storing multiple images in a single file...

Post by dodicat »

Here is another way (using arrays).

Code: Select all

 

Screen 20,32
#include "crt.bi"
#include "file.bi"

Type image
    As Ulong a(Any)
End Type

Function savefile(filename As String,p As String) As String
    Dim As Long n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:Sleep:End
    End If
    Return filename
End Function

Function loadfile(file As String) As String
	If Fileexists(file)=0 Then Print file;" not found":Sleep:End
    Dim As Long  f=Freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Function ap_pend(filename As String,txt As String) As String
    Dim As String s=loadfile(filename)
    savefile(filename,s+txt)
    Return filename
End Function

Sub transfer(p As Ulong Ptr,a() As Ulong)
    Dim As Integer sz
    Imageinfo p,,,,,,sz
    Redim a(sz)
    memcpy(@a(0),p,(Ubound(a)-Lbound(a)+1))
End Sub

Sub load(file As String,u() As Ulong)
    Var  f=Freefile
    If Fileexists(file)=0 Then Print file;"  not found":Return
    Open file For Binary Access Read As #f
    If Lof(f) > 0 Then
        Get #f, ,u()
    End If
    Close #f
End Sub

Sub save(file As String,u() As Ulong)
    Var h=Freefile
    Open file For Binary Access Write As #h
    Put #h, ,u()
    Close #h
End Sub

Sub createfile(filename As String,i() As Ulong Ptr)
    savefile(filename,"")
    Redim As Ulong a()
    Dim As String L
    For n As Long=1 To Ubound(i)
        transfer(i(n),a())
        save("t1.dat",a())'temp file
        L=loadfile("t1.dat")
        ap_pend(filename,L)
    Next n
    Kill "t1.dat"
End Sub

Sub getimagesfromfile(filename As String,i() As image)
    Dim As Long L=Filelen(filename)\Sizeof(Ulong)
    Dim As Ulong a(0 To L-1)
    load(filename,a())
    Dim As Long ctr1,ctr2
    For n As Long=0 To Ubound(a)'set up the arrays
        ctr1+=1
        If a(n)=7 And n<>0 Or n=Ubound(a) Then
            ctr2+=1
            Redim Preserve i(1 To ctr2)
            Redim (i(ctr2).a)(ctr1)
            ctr1=0
        End If
    Next n
    ctr1=0:ctr2=1'now fill the arrays
    For n As Long=0 To Ubound(a)
        If a(n)=7 And n<>0  Then
            ctr2+=1
            ctr1=0
        End If
        i(ctr2).a(ctr1)=a(n)
        ctr1+=1
    Next n
End Sub


'========================================
Dim As String filename="images.dat"
Dim As Integer x,y
Redim As Ulong Ptr i()
Redim As image u()

Randomize
Do
    
    Redim  i(1 To 3+Rnd*10)'create some images
    For n As Long=1 To Ubound(i)
        i(n)=Imagecreate(100+Rnd*50,200-Rnd*150,Rgb(Rnd*255,Rnd*255,Rnd*255))
        Imageinfo i(n),x,y
        For m As Long=1 To 50 'fill them
            Circle i(n),(Rnd*x,Rnd*y),5+Rnd*10,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f
        Next m
        Line i(n),(0,0)-(x-1,y-1),Rgb(255,255,255),b
    Next n
    
    createfile(filename,i())       'create the file of images
    getimagesfromfile(filename,u())'return images from file
    
    Windowtitle  Str(Ubound(u))+" images in file, filesize = "+Str(Filelen(filename))
    'show the images at random positions
    #define xp rnd*900
    #define yp rnd* 500
    For n As Long=Lbound(u) To Ubound(u)
        Put(xp,yp),@u(n).a(0),Pset
    Next n
    locate 2
    print "press a key, <esc> to end . . ."
    Sleep
    Cls
    'clear the images from memory
    For n As Long=Lbound(i) To Ubound(i)
        Imagedestroy(i(n))
        i(n)=0
    Next n
    
Loop Until Inkey=Chr(27)

Kill filename  '= "images.dat"

Sleep 
PublioMaro_Virgilivs
Posts: 19
Joined: Nov 23, 2020 16:45
Contact:

Re: Storing multiple images in a single file...

Post by PublioMaro_Virgilivs »

dodicat wrote:Here is another way (using arrays).
Thank you dodicat!!! I'll study your program too.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Storing multiple images in a single file...

Post by dodicat »

I have made it slightly easier, I have kept all the array work and image internals inside the subs, you now only deal with images, one bunch saved to file, the other retrieved from the file.
Check the help to find out about imageinfo and put using either a pointer or array, and any other things of course.
You will probably find paul doe's method a little easier.

Code: Select all


Screen 20,32
#include "crt.bi"
#include "file.bi"

Type image
    As Ulong a(Any)
End Type

Function savefile(filename As String,p As String) As String
    Dim As Long n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:Sleep:End
    End If
    Return filename
End Function

Function loadfile(file As String) As String
	If Fileexists(file)=0 Then Print file;" not found":Sleep:End
    Dim As Long  f=Freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

sub ap_pend(filename As String,txt As String)
    Dim As String s=loadfile(filename)
    savefile(filename,s+txt)
End sub

Sub transfer(p As Ulong Ptr,a() As Ulong)
    Dim As Integer sz
    Imageinfo p,,,,,,sz
    Redim a(sz)
    memcpy(@a(0),p,(Ubound(a)-Lbound(a)+1))
End Sub

Sub load(file As String,u() As Ulong)
    Var  f=Freefile
    If Fileexists(file)=0 Then Print file;"  not found":Return
    Open file For Binary Access Read As #f
    If Lof(f) > 0 Then
        Get #f, ,u()
    End If
    Close #f
End Sub

Sub save(file As String,u() As Ulong)
    Var h=Freefile
    Open file For Binary Access Write As #h
    Put #h, ,u()
    Close #h
End Sub

Sub createfile(filename As String,i() As Ulong Ptr)
    savefile(filename,"")'create the file
    Redim As Ulong a()
    Dim As String L
    For n As Long=1 To Ubound(i)
        transfer(i(n),a())'transfer the images to an array
        save("t1.dat",a())'temp file, to hold the array
        L=loadfile("t1.dat")'load the file into a string
        ap_pend(filename,L) 'append each new image (string) to the file
    Next n
    Kill "t1.dat"
End Sub

Sub getimagesfromfile(filename As String,im() As ulong ptr)
    redim as image i()
    Dim As Long L=Filelen(filename)\Sizeof(Ulong)
    Dim As Ulong a(0 To L-1)
    load(filename,a())
    Dim As Long ctr1,ctr2
    For n As Long=0 To Ubound(a)'set up the arrays
        ctr1+=1
        If a(n)=7 And n<>0 Or n=Ubound(a) Then
            ctr2+=1
            Redim Preserve i(1 To ctr2)
            Redim (i(ctr2).a)(ctr1)
            ctr1=0
        End If
    Next n
    ctr1=0:ctr2=1'now fill the arrays
    For n As Long=0 To Ubound(a)
        If a(n)=7 And n<>0  Then
            ctr2+=1
            ctr1=0
        End If
        i(ctr2).a(ctr1)=a(n)
        ctr1+=1
    Next n
    redim im(1 to ubound(i))'transfer arrays to the ulong ptr im()
    for n as long=1 to ubound(im)
        im(n)=imagecreate(i(n).a(2),i(n).a(3))'a(2)=width, a(3)=height see the help about internal image format
        put im(n),(0,0),@i(n).a(0),pset
        next n
End Sub

sub createsomeimages(i() as ulong ptr)
    Redim  i(1 To 3+Rnd*10)
    For n As Long=1 To Ubound(i)
        i(n)=Imagecreate(100+Rnd*50,200-Rnd*150,Rgb(Rnd*255,Rnd*255,Rnd*255))
        Dim As Integer x,y
        Imageinfo i(n),x,y
        var z= rnd >.5
        For m As Long=1 To 50 'fill them with circles or boxes
          if z then  
          Circle i(n),(Rnd*x,Rnd*y),5+Rnd*10,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f
         else 
          var kx=5+Rnd*5,ky=5+Rnd*5
          var xx=Rnd*x,yy=rnd*y
          line i(n),(xx+kx,yy+ky)-(xx-kx,yy-ky),Rgb(Rnd*255,Rnd*255,Rnd*255),bf
      end if
    Next m
    
        Line i(n),(0,0)-(x-1,y-1),Rgb(255,255,255),b'white border
        draw string i(n),(x/2,y/2),str(n)'number in centre
    Next n
    end sub


'========================================
Dim As String filename="images.dat"
Redim As Ulong Ptr i()  'created images to be sent to file
Redim As ulong ptr u()  'retrieved images from file

Randomize
Do
    createsomeimages(i())
    createfile(filename,i())       'create the file of images
    getimagesfromfile(filename,u())'return images from file
    'results:
    Windowtitle  Str(Ubound(u))+" images in file, filesize = "+Str(Filelen(filename))
    'show the images at random positions
    #define xp rnd*900
    #define yp rnd* 500
    For n As Long=Lbound(u) To Ubound(u)
        Put(xp,yp),u(n),Pset
    Next n
    locate 2
    print "press a key, <esc> to end . . ."
    Sleep
    Cls
    'clear the images from memory, so they can be re-done
    For n As Long=Lbound(i) To Ubound(i)
        Imagedestroy(i(n))
        i(n)=0
    Next n
    
Loop Until Inkey=Chr(27)

Kill filename  '= "images.dat" comment out if you want to keep the file

Sleep 
PublioMaro_Virgilivs
Posts: 19
Joined: Nov 23, 2020 16:45
Contact:

Re: Storing multiple images in a single file...

Post by PublioMaro_Virgilivs »

dodicat wrote:I have made it slightly easier, I have kept all the array work and image internals inside the subs, you now only deal with images, one bunch saved to file, the other retrieved from the file.
Check the help to find out about imageinfo and put using either a pointer or array, and any other things of course.
You will probably find paul doe's method a little easier.
You're right. But your example is educative for my learning purposes too. Thank you again.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Storing multiple images in a single file...

Post by dodicat »

Here is another way to do this.
Using bitmaps to store images.
These different ways are as many and varied as the days of Summer.

Code: Select all


Screen 20,32

#include "file.bi"
Sub string_split(Byval s As String,chars As String,result() As String)
    Redim result(0)
    Dim As String var1,var2
    Dim As Long pst,LC=Len(chars)
    #macro split(stri)
    pst=Instr(stri,chars)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+LC)
    Else
        var1=stri
    End If
    If Len(var1) Then 
        Redim Preserve result(1 To Ubound(result)+1)
        result(Ubound(result))=var1
    End If
    #endmacro
    Do
        split(s):s=var2
    Loop Until var2=""
End Sub

Function savefile(filename As String,p As String) As String
    Dim As Long n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:Sleep:End
    End If
    Return filename
End Function

Function loadfile(file As String) As String
	If Fileexists(file)=0 Then Print file;" not found":Sleep:End
    Dim As Long  f=Freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
        text = String(Lof(f), 0)
        Get #f, , text
    End If
    Close #f
    Return text
End Function

Sub ap_pend(filename As String,txt As String)
    Dim As String s=loadfile(filename)
    savefile(filename,s+txt)
End Sub

Sub createsomeimages(i() As Ulong Ptr)
    Redim  i(1 To 3+Rnd*10)
    For n As Long=1 To Ubound(i)
        i(n)=Imagecreate(100+Rnd*50,200-Rnd*150,Rgb(Rnd*255,Rnd*255,Rnd*255))
        Dim As Integer x,y
        Imageinfo i(n),x,y
        Var z= Rnd >.5
        For m As Long=1 To 50 'fill them with circles or boxes
            If z Then  
                Circle i(n),(Rnd*x,Rnd*y),5+Rnd*10,Rgb(Rnd*255,Rnd*255,Rnd*255),,,,f
            Else 
                Var kx=5+Rnd*5,ky=5+Rnd*5
                Var xx=Rnd*x,yy=Rnd*y
                Line i(n),(xx+kx,yy+ky)-(xx-kx,yy-ky),Rgb(Rnd*255,Rnd*255,Rnd*255),bf
            End If
        Next m
        Line i(n),(0,0)-(x-1,y-1),Rgb(255,255,255),b'white border
        Draw String i(n),(x/2,y/2),Str(n)'number in centre
    Next n
End Sub

Sub getsize(bmp As String,Byref w As Integer,Byref h As Integer)
    Open bmp For Binary As #1
    Get #1, 19, w
    Get #1, 23, h
    Close #1
End Sub

Sub createfile(filename As String,i() As Any Ptr)
    Var delim="_______"
    savefile(filename,"")
    For n As Long=1 To Ubound(i)
        Bsave("file1.bmp",i(n))
        Var L=loadfile("file1.bmp")
        L+=delim
        ap_pend(filename,L)
    Next n
    Kill "file1.bmp"
End Sub

Sub retrieveimagesfromfile(filename As String,i() As Any Ptr)
    Var delim="_______" 
    Var L=loadfile(filename)
    Redim As String s()
    string_split(L,delim,s()) 'split a string on deliminator.
    Redim i(1 To Ubound(s))
    Dim As Integer w,h
    For n As Long=1 To Ubound(s)
        savefile("file1.bmp",s(n))
        getsize("file1.bmp",w,h)
        i(n)=Imagecreate(w,h)
        Bload("file1.bmp",i(n))
    Next n
    Kill "file1.bmp"
End Sub

Redim As Any Ptr i()   'to be saved in a file
Redim As Any Ptr ret() 'retrieved from the file
Dim As String filename="images.dat"
#define xp rnd*900
#define yp rnd* 500
randomize
Do
    cls
    
    createsomeimages(i())
    createfile(filename,i())
    retrieveimagesfromfile(filename,ret())
    
    Windowtitle  Str(Ubound(ret))+" images in file, filesize = "+Str(Filelen(filename))
    For n As Long=Lbound(ret) To Ubound(ret)
        Put(xp,yp),ret(n),Pset
    Next n
    
    Locate 2
    Print "press a key, <esc> to end . . ."
    Sleep
    
    'clear the images from memory, so they can be re-done
    For n As Long=Lbound(i) To Ubound(i)
        Imagedestroy(i(n))
        imagedestroy(ret(n))
        i(n)=0
        ret(n)=0
    Next n
    
Loop Until Inkey=Chr(27)

Sleep
Kill filename  '= "images.dat" comment out if you want to keep the file

 
Post Reply