I can't tell how often i've used this tool.
'Animated gif to DirectX sprite converter (IBasic Standard)
'Jolly Roger April 2005
AUTODEFINE "OFF"
DEF win:WINDOW
DEF run:INT
DEF giffile:BFILE
DEF gifmem:MEMORY
DEF gifwidth,gifheight:WORD
DEF error,n,numberofframes:int
DEF lastbyteininitialblocks,imagestartbyte[100],imageendbyte[100]:int
DEF disposalmethod[100],imageleft[100],imagetop[100],canvascolour:int
DEF maxwindowwidth,maxwindowheight,left,top,usablewidth,usableheight:INT
DEF maxnumberofframesacross,maxnumberofframesdown:int
DEF numberofframesacross,numberofframesdown,transparencyenabled[100]:int
DEF filename$,spritefilename$:STRING
DEF onebyte:CHAR
'Find largest possible window size
WINDOW win,0, 0, 640, 480,@MAXBOX|@MAXIMIZED, 0, "", main
GETSIZE win,left,top,maxwindowwidth,maxwindowheight
CLOSEWINDOW win
WAITUNTIL win=0
'Open largest possible window
WINDOW win,0, 0, maxwindowwidth, maxwindowheight,@MINBOX, 0, "Animated gif to sprite", main
'Find usable area of window
GETCLIENTSIZE win,left,top,usablewidth,usableheight
'Create button
CONTROL win,"B,Choose animated gif to convert to DirectX sprite,usablewidth*.2,usableheight*.8,usablewidth*.6,usableheight*.05,0, 1"
GOSUB InitSaveBitmap
run = 1: WAITUNTIL run = 0
CLOSEWINDOW win
END
SUB main
SELECT @CLASS
CASE @IDCLOSEWINDOW
run = 0
CASE @IDCONTROL
'Button pressed
'Hide button
SHOWWINDOW win,0,1
numberofframes=0
filename$=FILEREQUEST("Choose animated gif to convert to sprite",win,1,"GIF files|*.gif*||","",0,GETSTARTPATH)
error=OPENFILE(giffile,filename$,"R")
IF error=0
'Clear the screen
RECT win,0,0,usablewidth,usableheight,0xFFFFFF,0xFFFFFF
'Allocate memory for gif
ALLOCMEM gifmem,LEN(giffile),1
'Read the gif file into memory
READ giffile,gifmem
CLOSEFILE giffile
GOSUB scangiffile
'Work out maximum number of frames that will fit in window
maxnumberofframesacross=FLOOR(usablewidth/gifwidth)
maxnumberofframesdown=FLOOR(usableheight/gifheight)
IF maxnumberofframesdown*maxnumberofframesacross<numberofframes
'Not enough room to create sprite
MESSAGEBOX win,"Sprite too large to fit on window","Oops",64
numberofframes=0
ELSE
IF numberofframes>1
GOSUB extractimages
GOSUB findbestframearrangement
GOSUB createspritebitmap
MOVE win,usablewidth*.2,usableheight*.9
PRINT win,"Saved as ",spritefilename$," .",numberofframes," frames.Width ",gifwidth,".Height ",gifheight
ELSE
MOVE win,usablewidth*.4,usableheight*.9
PRINT win,"File is not an animated gif"
ENDIF
FREEMEM gifmem
ENDIF
ENDIF
'Show button
SHOWWINDOW win,1,1
ENDSELECT
RETURN
SUB extractimages
'Extract all the images from the animated gif and save them as gif files
DEF frameimagefile:BFILE
DEF frame:INT
'Draw progress bar outline
RECT win,usablewidth*.3,usableheight*.7,usablewidth*.4,usableheight*.05,0
FOR frame=0 TO numberofframes-1
error=OPENFILE (frameimagefile,GETSTARTPATH+"frame"+LTRIM$(STR$(frame))+".gif","W")
IF error=0
'Copy initial blocks to file
FOR n=1 TO lastbyteininitialblocks
READMEM gifmem,n,onebyte
WRITE frameimagefile,onebyte
NEXT n
'Copy image data to file
FOR n=imagestartbyte[frame] TO imageendbyte[frame]
READMEM gifmem,n,onebyte
WRITE frameimagefile,onebyte
NEXT n
'Add end of file byte
onebyte=0x3B
WRITE frameimagefile,onebyte
CLOSEFILE frameimagefile
ENDIF
'Draw progress bar
RECT win,usablewidth*.3,usableheight*.7,usablewidth*.4*(frame+1)/numberofframes,usableheight*.05,0,0
NEXT frame
RETURN
SUB scangiffile
DEF canvascolournumber,sizeofcolourtable,blockstartbyte,blocklength:INT
DEF foundgraphicextnblock,finished:INT
foundgraphicextnblock=0:finished=0
'Read header
'Read width and height
READMEM gifmem,7,onebyte
gifwidth=onebyte
READMEM gifmem,8,onebyte
gifwidth=gifwidth+onebyte*256
READMEM gifmem,9,onebyte
gifheight=onebyte
READMEM gifmem,10,onebyte
gifheight=gifheight+onebyte*256
READMEM gifmem,11,onebyte
blockstartbyte=14
IF (onebyte&255)>127
sizeofcolourtable=3*2^(1+(onebyte&7))
'Find number of canvas colour
READMEM gifmem,12,onebyte
canvascolournumber=onebyte&255
'Find canvas colour
READMEM gifmem,blockstartbyte+3*canvascolournumber,onebyte
canvascolour=onebyte
READMEM gifmem,blockstartbyte+3*canvascolournumber+1,onebyte
canvascolour=canvascolour+256*onebyte
READMEM gifmem,blockstartbyte+3*canvascolournumber+2,onebyte
canvascolour=canvascolour+256*256*onebyte
ELSE
sizeofcolourtable=0
ENDIF
blockstartbyte=blockstartbyte+sizeofcolourtable
lastbyteininitialblocks=blockstartbyte-1:'Store number of last byte in initial blocks
DO
READMEM gifmem,blockstartbyte,onebyte
SELECT HEX$(onebyte)
CASE "21"
READMEM gifmem,blockstartbyte+1,onebyte
SELECT HEX$(onebyte)
CASE "FF"
'Read number of bytes left in block
READMEM gifmem,blockstartbyte+2,onebyte
blockstartbyte=blockstartbyte+onebyte+3
'Read through the sub chunks
DO
READMEM gifmem,blockstartbyte,onebyte: 'Read the length of the sub chunk
blockstartbyte=blockstartbyte+onebyte+1
UNTIL onebyte=0 | blockstartbyte>LEN(gifmem):'Keep reading till find a sub chunk with length zero
CASE "F9"
foundgraphicextnblock=1
'Read number of bytes left in block
READMEM gifmem,blockstartbyte+2,onebyte
imagestartbyte[numberofframes]=blockstartbyte
blocklength=onebyte+4
'Read packed byte
READMEM gifmem,blockstartbyte+3,onebyte
disposalmethod[numberofframes]=(onebyte&28)/4
transparencyenabled[numberofframes]=onebyte&1
'Skip to beginning of next block
blockstartbyte=blockstartbyte+blocklength
CASE "1"
'Read block length
READMEM gifmem,blockstartbyte+2,onebyte
blockstartbyte=blockstartbyte+onebyte+3
'Read sub blocks
DO
READMEM gifmem,blockstartbyte,onebyte: 'Read the length of the sub chunk
blockstartbyte=blockstartbyte+onebyte+1
UNTIL onebyte=0 | blockstartbyte>LEN(gifmem):'Keep reading till find a sub chunk with length zero
foundgraphicextnblock=0
CASE "FE"
blockstartbyte=blockstartbyte+2
'Read sub blocks
DO
READMEM gifmem,blockstartbyte,onebyte: 'Read the length of the sub chunk
blockstartbyte=blockstartbyte+onebyte+1
UNTIL onebyte=0 | blockstartbyte>LEN(gifmem):'Keep reading till find a sub chunk with length zero
DEFAULT
finished=1
ENDSELECT
CASE "2C"
'Found image descriptor block
'Read left and top position of image
READMEM gifmem,blockstartbyte+1,onebyte
imageleft[numberofframes]=onebyte
READMEM gifmem,blockstartbyte+2,onebyte
imageleft[numberofframes]=imageleft[numberofframes]+256*onebyte
READMEM gifmem,blockstartbyte+3,onebyte
imagetop[numberofframes]=onebyte
READMEM gifmem,blockstartbyte+4,onebyte
imagetop[numberofframes]=imagetop[numberofframes]+256*onebyte
'Read last byte in image descriptor block
READMEM gifmem,blockstartbyte+9,onebyte
blockstartbyte=blockstartbyte+10
IF (onebyte&255)>127
'Local colour table follows this block.Skip it
sizeofcolourtable=3*2^(1+(onebyte&7))
blockstartbyte=blockstartbyte+sizeofcolourtable
ENDIF
'Read image compression data byte
READMEM gifmem,blockstartbyte,onebyte
blockstartbyte=blockstartbyte+1
'Read image sub blocks
DO
READMEM gifmem,blockstartbyte,onebyte: 'Read the length of the sub chunk
blockstartbyte=blockstartbyte+(onebyte&255)+1
UNTIL onebyte=0 | blockstartbyte>LEN(gifmem):'Keep reading till find a sub chunk with length zero
imageendbyte[numberofframes]=blockstartbyte-1
IF foundgraphicextnblock THEN numberofframes=numberofframes+1
foundgraphicextnblock=0
DEFAULT
finished=1
ENDSELECT
READMEM gifmem,blockstartbyte,onebyte
UNTIL finished
RETURN
SUB createspritebitmap
DEF frame,temporaryimage:INT
DEF filenamewithoutpath$:STRING
'Clear screen
RECT win,0,0,usablewidth,usableheight,0xFFFFFF,0xFFFFFF
'Convert gif images to frame bitmaps
FOR n=0 TO numberofframes-1
IF disposalmethod[n]=3 & n>0
'Save current image on window as will need to restore it later
SaveBitmap(GETSTARTPATH+"temporary.bmp",win,0,0,gifwidth,gifheight)
ENDIF
frame=LOADIMAGE(GETSTARTPATH+"frame"+LTRIM$(STR$(n))+".gif",@IMGSCALABLE)
SHOWIMAGE win,frame,@IMGSCALABLE,imageleft[n],imagetop[n]
'Save image as bitmap
SaveBitmap(GETSTARTPATH+"frame"+LTRIM$(STR$(n))+".bmp",win,0,0,gifwidth,gifheight)
DELETEIMAGE frame,@IMGSCALABLE
IF disposalmethod[n]=2
IF transparencyenabled[n]
'Fill image with white
RECT win,0,0,gifwidth,gifheight,0xFFFFFF,0xFFFFFF
ELSE
'Fill image with canvas colour
RECT win,0,0,gifwidth,gifheight,canvascolour,canvascolour
ENDIF
ENDIF
IF disposalmethod[n]=3
'Restore image on window to what it was before drew gif
IF n>0
frame=LOADIMAGE(GETSTARTPATH+"temporary.bmp",@IMGSCALABLE)
SHOWIMAGE win,frame,@IMGSCALABLE,0,0
DELETEIMAGE frame,@IMGSCALABLE
ELSE
'Fill image with white
RECT win,0,0,gifwidth,gifheight,0xFFFFFF,0xFFFFFF
ENDIF
ENDIF
NEXT n
'Create sprite on the window
FOR n=0 TO numberofframes-1
frame=LOADIMAGE(GETSTARTPATH+"frame"+LTRIM$(STR$(n))+".bmp",@IMGSCALABLE)
SHOWIMAGE win,frame,@IMGSCALABLE,(n%numberofframesacross)*gifwidth,gifheight*FLOOR(n/numberofframesacross)
DELETEIMAGE frame,@IMGSCALABLE
NEXT n
'Generate filename for sprite
FOR n=LEN(filename$) TO 1 STEP -1
IF MID$(filename$,n,1)=CHR$(92) :'Look for backslash
filenamewithoutpath$=MID$(filename$,n+1)
n=1
ENDIF
NEXT n
spritefilename$=LEFT$(filenamewithoutpath$,LEN(filenamewithoutpath$)-4)+"-sprite.bmp"
'Save sprite as bitmap
SaveBitmap(GETSTARTPATH+spritefilename$,win,0,0,gifwidth*numberofframesacross,gifheight*numberofframesdown)
'Delete temporary image files
DELETEFILE (GETSTARTPATH+"temporary.bmp")
FOR n=0 TO numberofframes-1
DELETEFILE (GETSTARTPATH+"frame"+LTRIM$(STR$(n))+".gif")
DELETEFILE (GETSTARTPATH+"frame"+LTRIM$(STR$(n))+".bmp")
NEXT n
RETURN
SUB findbestframearrangement
'Find arrangement of frames that gives least wastage
DEF bestnumberofframesdown:int
DEF wastage[100],minwastage:int
FOR numberofframesdown=1 TO (numberofframes/2)
numberofframesacross=CEIL(numberofframes/numberofframesdown)
IF (numberofframesacross<=maxnumberofframesacross) & (numberofframesdown<=maxnumberofframesdown)
'This arrangement of frames will fit on window
wastage[numberofframesdown]=(numberofframesdown*numberofframesacross)-numberofframes
ELSE
'Won't fit on window
wastage[numberofframesdown]=numberofframes
ENDIF
NEXT numberofframesdown
bestnumberofframesdown=0:minwastage=numberofframes
FOR numberofframesdown=1 TO numberofframes/2
IF wastage[numberofframesdown]<minwastage
bestnumberofframesdown=numberofframesdown
minwastage=wastage[numberofframesdown]
ENDIF
NEXT numberofframesdown
numberofframesdown=bestnumberofframesdown
numberofframesacross=CEIL(numberofframes/numberofframesdown)
RETURN
'*************************************************************
'SaveBitmap.iba
'definitions and functions to save a bitmap from a window
'to use paste this file at the end of your source code
'or create and include it as a component
'
'Insert GOSUB InitSaveBitmap in your program to initialize all the API
'declares needed. Then to save a portion of your window as a bitmap just use:
'SaveBitmap filename, window, left, top, width, height
'See the modified draw.iba sample included with the archive for a demo
SUB InitSaveBitmap
DECLARE "gdi32",BitBlt(HDCDest:int,destx:int,desty:int,destw:int,desth:int,HDCSrc:int,srcx:int,srcy:int,rop:INT),int
DECLARE "gdi32",CreateCompatibleBitmap(HDC:int,width:int,height:int),int
DECLARE "gdi32",CreateCompatibleDC(HDC:int),int
DECLARE "gdi32",SelectObject(HDC:int,Handle:int),int
DECLARE "gdi32",DeleteDC(HDC:int),int
DECLARE "gdi32",DeleteObject(handle:int),int
DECLARE "gdi32",GetObjectA(handle:int,size:int,mem:MEMORY),int
DECLARE "gdi32",GetDIBits(HDC:int,hbitmap:int,start:int,lines:int,bits:MEMORY,info:MEMORY,usage:INT),int
TYPE BITMAP
DEF bmType:INT
DEF bmWidth:INT
DEF bmHeight:INT
DEF bmWidthCHARs:INT
DEF bmPlanes:WORD
DEF bmBitsPixel:WORD
DEF bmBits:INT
ENDTYPE
TYPE BITMAPINFOHEADER
DEF biSize:INT
DEF biWidth:INT
DEF biHeight:INT
DEF biPlanes:WORD
DEF biBitCount:WORD
DEF biCompression:INT
DEF biSizeImage:INT
DEF biXPelsPerMeter:INT
DEF biYPelsPerMeter:INT
DEF biClrUsed:INT
DEF biClrImportant:INT
ENDTYPE
TYPE BITMAPFILEHEADER
DEF bfType:WORD
DEF bfSize:INT
DEF bfReserved1:WORD
DEF bfReserved2:WORD
DEF bfOffBits:INT
ENDTYPE
DECLARE SaveBitmap(filename:string,win:window,l:int,t:int,w:int,h:int)
DECLARE CreateInfoStructure(win:WINDOW,hbitmap:int,info:BITMAPINFOHEADER)
RETURN
SUB SaveBitmap(filename:string,win:window,l:int,t:int,w:int,h:int)
def hdcWin,hdcComp,hbitmap,hbitmapold,quadsize:int
def info:BITMAPINFOHEADER
def fileheader:BITMAPFILEHEADER
def lpbits,lpbminfo:MEMORY
def file:BFILE
hdcWin = GetHDC(win)
hdcComp = CreateCompatibleDC(hdcWin)
if hdcComp = 0
messagebox win,"Couldn't create DC","Error"
ReleaseHDC hdcWin
return
endif
hbitmap = CreateCompatibleBitmap(hdcwin,w,h)
if hbitmap = 0
messagebox win,"Couldn't create bitmap","Error"
ReleaseHDC hdcWin
endif
hbitmapold = SelectObject(hdcComp,hbitmap)
BitBlt(hdcComp,0,0,w,h,hdcWin,l,t,0x00CC0020)
SelectObject(hdcComp,hbitmapold)
DeleteDC(hdcComp)
REM at this point hbitmap contains a valid bitmap handle.
REM fill in the BITMAPINFOHEADER and compute the color data
quadsize = CreateInfoStructure(win,hbitmap,info)
REM allocate memory and get the 'bits' of the bitmap
allocmem lpbits,1,info.biSizeImage
allocmem lpbminfo,1,len(info) + quadsize
writemem lpbminfo,1,info
GetDIBits(hdcWin,hbitmap,0,info.biHeight,lpbits,lpbminfo,0)
REM open a binary file and write the header,color data and bitmap bits
if(openfile(file,filename,"W") = 0)
fileheader.bfType = 0x4d42
fileheader.bfSize = len(fileheader) + info.biSize + quadsize + info.biSizeImage
fileheader.bfOffBits = len(fileheader) + info.biSize + quadsize
write file,fileheader
write file,lpbminfo
write file,lpbits
closefile file
endif
freemem lpbminfo
freemem lpbits
ReleaseHDC win,hdcWin
DeleteObject(hbitmap)
RETURN
SUB CreateInfoStructure(win:WINDOW,hbitmap:int,info:BITMAPINFOHEADER)
def bmp:BITMAP
def mem:MEMORY
def cClrBits:WORD
def quadsize:int
Allocmem mem,1,len(bmp)
GetObjectA(hbitmap,len(bmp),mem)
readmem mem,1,bmp
freemem mem
cClrBits = bmp.bmPlanes * bmp.bmBitsPixel
if (cClrBits = 1)
cClrBits = 1
else
if (cClrBits <= 4)
cClrBits = 4
else
if (cClrBits <= 8)
cClrBits = 8
else
if (cClrBits <= 16)
cClrBits = 16
else
if (cClrBits <= 24)
cClrBits = 24
else
cClrBits = 32
endif
endif
endif
endif
endif
info.biSize = len(info)
info.biWidth = bmp.bmWidth
info.biHeight = bmp.bmHeight
info.biPlanes = bmp.bmPlanes
info.biBitCount = bmp.bmBitsPixel
if (cClrBits < 24)
info.biClrUsed = 2^cClrBits
endif
info.biCompression = 0
info.biSizeImage = (info.biWidth + 7) / 8 * info.biHeight * cClrBits
if(cClrBits <> 24)
quadsize = 4 * (2^cClrBits)
endif
RETURN quadsize