AVImake: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  AVImake.frm                                                               *
'                                                                            *
'  This program creates an AVI file from an FLI or FLC file.                 *
'                                                                            *
'*****************************************************************************
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim cxBuffer As Long, cyBuffer As Long
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   cxBuffer = 32
   cyBuffer = 32
   hVB = fg_vballoc(cxBuffer, cyBuffer)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   Call fg_setcolor(-1)
   Call fg_fillpage
End Sub
Private Sub Form_Paint()
   Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
Private Sub mnuConvert_Click()
   Dim Bitmap() As Byte
   Dim ContextFlic(16) As Byte
   Dim ContextAVI(24) As Byte
   Dim FileHeader(128) As Byte
   Dim FileName As String
   Dim mbString As String
   On Error GoTo ErrHandler
   ' open the flic file to convert
   CommonDialog1.CancelError = True
   CommonDialog1.DefaultExt = "fli"
   CommonDialog1.FileName = ""
   CommonDialog1.Filter = "flic files (*.fli,*.flc)|*.FLI;*.FLC"
   CommonDialog1.Flags = cdlOFNReadOnly
   CommonDialog1.InitDir = App.Path
   CommonDialog1.ShowOpen
   FileName = CommonDialog1.FileName
   ' make sure it really is a flic file, and if so, open it
   If fg_flichead(FileName, FileHeader(0)) < 0 Then
      Call MsgBox(FileName + " is not an FLI or FLC file.", vbCritical, "Error")
      Exit Sub
   End If
   Call fg_flicsize(FileHeader(0), cxBuffer, cyBuffer)
   Call SwitchBuffers
   Call fg_flicopen(FileName, ContextFlic(0))
   ' display the first flic frame
   Call fg_flicplay(ContextFlic(0), 1, FG_NODELAY)
   Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
   ' create an empty AVI file with the same name as the flic file,
   ' but with an .avi extension
   FileName = Left(FileName, InStr(FileName, ".") - 1) + ".avi"
   If fg_avimake(FileName, ContextAVI(0), -1, cxBuffer, cyBuffer, 8, 10000, 30) < 0 Then
      Call MsgBox("Cannot create AVI file" + vbCr + FileName, vbCritical, "Error")
      Exit Sub
   End If
   ' create a 256-color bitmap whose size is equal to the flic resolution
   ReDim Bitmap(fg_imagesiz(cxBuffer, cyBuffer))
   ' create the AVI file frame by frame
   Screen.MousePointer = 11
   Call fg_move(0, cyBuffer - 1)
   Do
      Call fg_vbscale(0, cxBuffer - 1, 0, cyBuffer - 1, 0, cxClient - 1, 0, cyClient - 1)
      Call fg_getimage(Bitmap(0), cxBuffer, cyBuffer)
      Call fg_aviframe(ContextAVI(0), Bitmap(0))
   Loop While fg_flicplay(ContextFlic(0), 1, FG_NODELAY) = 1
   Screen.MousePointer = 0
   ' close the flic and AVI files, and release the bitmap memory
   Call fg_flicdone(ContextFlic(0))
   Call fg_avidone(ContextAVI(0))
   Erase Bitmap
ErrHandler:  ' user pressed Cancel button
End Sub
Private Sub mnuExit_Click()
   Unload Me
End Sub
'*****************************************************************************
'                                                                            *
'  SwitchBuffers()                                                           *
'                                                                            *
'  Close the and release the active virtual buffer, then create and open a   *
'  new virtual buffer to hold the new image file.                            *
'                                                                            *
'*****************************************************************************
Private Sub SwitchBuffers()
   Call fg_vbclose
   Call fg_vbfree(hVB)
   hVB = fg_vballoc(cxBuffer, cyBuffer)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
End Sub