*.Ani interpretation

[Semen Matusovski]

22.02. Changed If @pIconDir.idCount <> 1 Then Er = 1: Exit Do
to If @pIconDir.idCount < 1 Then Er = 1: Exit Do
because of incorrect Windows95\Cursors\*.ani (some ICON include more than one icon)

   #Compile Exe
   #Dim All
   #Register None
   #Include "Win32Api.Inc"

   $FileAni = "G:\Winnt\cursors\metronom.ani" ' <-- Change

   Type ANIHEADER
       cbSizeOf  As Dword ' // Num bytes In AniHeader (36 bytes)
       cFrames   As Dword ' // Number of unique Icons In this cursor
       cSteps    As Dword ' // Number of Blits before the animation cycles
       cx        As Dword ' // reserved, must be zero.
       cy        As Dword ' // reserved, must be zero.
       cBitCount As Dword ' // reserved, must be zero.
       cPlanes   As Dword ' // reserved, must be zero.
       JifRate   As Dword ' // Default Jiffies (1/60th of a second) If rate chunk Not present.
       flags     As Dword ' // Animation Flag (see AF_ constants)
   End Type

   Type ICONDIR
      idReserved As Word ' // Reserved (must be 0)
      idType  As Word    ' // Resource Type (1 For icons)
      idCount As Word    ' // How many images?
   End Type

   Type ICONDIRENTRY
      bWidth As Byte         ' // Width, In Pixels, of the Image
      bHeight As Byte        ' // Height, In Pixels, of the Image
      bColorCount As Byte    ' // Number of colors In Image (0 If >=8bpp)
      bReserved As Byte      ' // Reserved ( must be 0)
      wPlanes As Word        ' // Color Planes
      wBitCount As Word      ' // Bits per pixel
      dwBytesInRes As Dword  ' // How many bytes In this resource?
      dwImageOffset As Dword ' // Where In the file is this image?
   End Type

   Union DwordString
      d As Dword
      s As String * 4
   End Union

   Function ConvertAni (sAni As String, cFrames As Dword, hIcon() As Dword, cSteps As Dword, Rate() As Dword, Seq() As Dword) As Long
      Dim pAniHeader As ANIHEADER Ptr, pAni As DwordString Ptr, pAniM As Dword, kFrame As Dword, Er As Dword
      Dim i As Long, j As Long
      cFrames = 0: cSteps = 0
      For i = 1 To 2
         pAni = StrPtr(sAni): pAniM = pAni + Len(sAni)
         Do
            If pAni >= pAniM Then Exit Do
            Select Case UCase$(@pAni.s)
               Case "RIFF", "LIST": pAni = pAni + 8
               Case "ACON", "INFO", "FRAM": pAni = pAni + 4
               Case "INAM", "IART": pAni = pAni + 8 + 2 * Fix((@pAni[1].d + 1) / 2)
               Case "ANIH"
                  pAniHeader = pAni + 8
                  If i = 1 Then
                     cFrames = @pAniHeader.cFrames
                     cSteps = @pAniHeader.cSteps
                     If (cFrames > 0) And (cSteps > 0) Then
                        ReDim hIcon(1 To cFrames) As Dword, Rate(1 To cSteps), Seq(1 To cSteps)
                        For j = 1 To cSteps: Rate(j) = @pAniHeader.JifRate: Next: _
                        For j = 1 To cSteps: Seq(j) = j - 1: Next
                     Else
                        Er = 1
                     End If
                  End If
                  pAni = pAniHeader + @pAniHeader.cbSizeOf
               Case "RATE"
                  If i = 2 Then
                     If @pAni[1].d <> 4 * cSteps Then Er = 1 Else _
                        For j = 1 To cSteps: Rate(j) = @pAni[1 + j].d: Next
                  End If
                  pAni = pAni + 8 + @pAni[1].d
               Case "SEQ "
                  If i = 2 Then
                     If @pAni[1].d <> 4 * cSteps Then Er = 1 Else _
                        For j = 1 To cSteps: Seq(j) = @pAni[1 + j].d: Next
                  End If
                  pAni = pAni + 8 + @pAni[1].d
               Case "ICON"
                  If i = 2 Then
                     Dim pIconDir As ICONDIR Ptr
                     pIconDir = pAni + 8
                     Dim IconDirEntry() As ICONDIRENTRY
                     ReDim IconDirEntry(1 To @pIconDir.idCount) At pIconDir + SizeOf(@pIcondir)
                     If @pIconDir.idCount < 1 Then Er = 1: Exit Do
                     If kFrame >= cFrames Then Er = 1: Exit Do
                     Incr kFrame
                     hIcon(kFrame) = CreateIconFromResource(ByVal pIconDir + IconDirEntry(1).dwImageOffset, _
                        IconDirEntry(1).dwBytesInRes, 1, &H00030000&)
                  End If
                  pAni = pAni + 8 + @pAni[1].d
               Case Else
                  Er = 1: Exit Do
             End Select
          Loop
          If cFrames = 0 Then Er = 1
          If Er Then Exit For
       Next
       If kFrame <> cFrames Then Er = 1
       If Er Then
          For i = 1 To kFrame
             If hIcon(i) Then DeleteObject hIcon(i)
          Next
          cFrames = 0
       End If
       Function = Er
   End Function

   CallBack Function DlgProc
      Dim cFrames As Static Dword, hIcon(0) As Static Dword, cSteps As Static Dword, Rate(0) As Static Dword, Seq(0) As Static Dword
      Static kStep As Long
      Select Case CbMsg
         Case %WM_INITDIALOG
            Local lWidth As Long, lHeight As Long
            Dialog Pixels CbHndl, 32, 32 To Units lWidth, lHeight
            Control Add Image, CbHndl, 101, "", 5, 5, lWidth, lHeight

            Dim sAni As String
            Open $FileAni For Binary Shared As #1: Get$ #1, Lof(1), sAni: Close #1
            If ConvertAni(sAni, cFrames, hIcon(), cSteps, Rate(), Seq()) Then _
               MsgBox "Problems", %MB_TASKMODAL: PostMessage CbHndl, %WM_SYSCOMMAND, %SC_CLOSE, 0

            PostMessage CbHndl, %WM_TIMER, 1, 0
         Case %WM_TIMER
            If CbCtl = 1 Then
               Incr kStep: If kStep > cSteps Then kStep = 1
               SendMessage CbHndl, %WM_SETICON, %ICON_SMALL, hIcon(Seq(kStep) + 1)
               SendMessage GetDlgItem(CbHndl, 101), %STM_SETIMAGE, %IMAGE_ICON, hIcon(Seq(kStep) + 1)
               SetTimer CbHndl, 1, Rate(kStep) * 1000 / 60, ByVal 0&
            End If
         Case %WM_DESTROY
            KillTimer CbHndl, 1
            Local i As Long
            For i = 1 To cFrames
               If hIcon(i) Then DeleteObject hIcon(i)
            Next
      End Select
   End Function

   Function PbMain
      Local hDlg As Long
      Dialog New 0, "Ani", , , 50, 40, %WS_CAPTION Or %WS_SYSMENU To hDlg
      Dialog Show Modal hDlg Call DlgProc
   End Function

[This message has been edited by Semen Matusovski (edited February 22, 2001).]