IonicWind Software

Creative Basic => GUI Programs => Topic started by: pistol350 on September 04, 2007, 09:40:53 AM

Title: Animated gif to DirectX sprite converter by Jolly Roger
Post by: pistol350 on September 04, 2007, 09:40:53 AM
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