AnimationGlobalLoop Property

Imports Leadtools
Imports Leadtools.Codecs
Imports Leadtools.ImageProcessing
Imports Leadtools.Drawing

' WIN32 API
Const LOGPIXELSY As Integer = 90
<DllImport("gdi32")> _
Shared Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal nIndex As Integer) As Integer
End Function

<DllImport("kernel32")> _
Shared Function MulDiv(ByVal nNumber As Integer, ByVal nNumerator As Integer, ByVal nDenominator As Integer) As Integer
End Function

Sub AnimatedGIFExample()
   ' The GIF file will contain 4 frames
   Const frameCount As Integer = 4

   ' Each frame is 128 by 128 pixels (the GIF file will have double that size)
   Const frameWidth As Integer = 128
   Const frameHeight As Integer = 128

   ' Background colors
   Dim backColor() As RasterColor = _
   { _
      New RasterColor(&HFF, &H0, &H0), _
      New RasterColor(&H0, &HFF, &H0), _
      New RasterColor(&H0, &H0, &HFF), _
      New RasterColor(&HFF, &HFF, &H0) _
   }

   ' Foreground colors
   Dim foreColor() As RasterColor = _
   { _
      New RasterColor(&HFF, &HFF, &H0), _
      New RasterColor(&HFF, &H0, &H0), _
      New RasterColor(&H0, &HFF, &H0), _
      New RasterColor(&HFF, &H0, &H0) _
   }

   ' Delay in milliseconds
   Dim delay() As Integer = _
   { _
      1000, _
      1000, _
      1000, _
      1000 _
   }

   ' Left and top, we want the frames to move to each corner
   Dim offset() As LeadPoint = _
   { _
      New LeadPoint(0, 0), _
      New LeadPoint(frameWidth, 0), _
      New LeadPoint(frameWidth, frameHeight), _
      New LeadPoint(0, frameHeight) _
   }

   Dim disposalMethod() As RasterImageAnimationDisposalMethod = _
   { _
      RasterImageAnimationDisposalMethod.RestoreBackground, _
      RasterImageAnimationDisposalMethod.RestoreBackground, _
      RasterImageAnimationDisposalMethod.RestoreBackground, _
      RasterImageAnimationDisposalMethod.RestoreBackground _
   }

   Dim backgroundColor As RasterColor = RasterColor.FromKnownColor(RasterKnownColor.Yellow)

   Dim image As RasterImage = Nothing
   Dim myFont As Font = Nothing
   Dim myStringFormat As StringFormat = Nothing

   ' Create the frames
   For frame As Integer = 0 To frameCount - 1
      Dim frameImage As New RasterImage( _
         RasterMemoryFlags.Conventional, _
         frameWidth, _
         frameHeight, _
         24, _
         RasterByteOrder.Bgr, _
         RasterViewPerspective.BottomLeft, _
         Nothing, _
         IntPtr.Zero, _
         0)

      ' Set the frame properties
      frameImage.AnimationDelay = delay(frame)
      frameImage.AnimationOffset = offset(frame)
      frameImage.AnimationDisposalMethod = disposalMethod(frame)

      ' Background is white
      frameImage.AnimationBackground = backgroundColor

      ' Draw the number of the frame on its surface
      Dim hdc As IntPtr = RasterImagePainter.CreateLeadDC(frameImage)
      Dim g As Graphics = Graphics.FromHdc(hdc)
      Dim rc As New Rectangle(0, 0, frameWidth, frameHeight)

      Dim brush As New SolidBrush(RasterColorConverter.ToColor(backColor(frame)))
      g.FillRectangle(brush, rc)
      brush.Dispose()

      If (myFont Is Nothing) Then
         Dim fontHeight As Integer = MulDiv(72, GetDeviceCaps(hdc, LOGPIXELSY), 72)
         myFont = New Font("Consolas", fontHeight)

         myStringFormat = New StringFormat()
         myStringFormat.Alignment = StringAlignment.Center
         myStringFormat.LineAlignment = StringAlignment.Center
      End If

      Dim str As String = String.Format("{0}", frame + 1)

      brush = New SolidBrush(RasterColorConverter.ToColor(foreColor(frame)))
      g.DrawString(str, myFont, brush, rc, myStringFormat)
      brush.Dispose()

      g.Dispose()
      RasterImagePainter.DeleteLeadDC(hdc)

      If (image Is Nothing) Then
         image = frameImage
      Else
         image.AddPage(frameImage)
      End If
   Next

   myFont.Dispose()
   myStringFormat.Dispose()

   ' Setup the global image properties
   image.AnimationGlobalSize = New LeadSize(frameWidth * 2, frameHeight * 2)
   image.AnimationGlobalLoop = 0
   image.AnimationGlobalBackground = backgroundColor

   ' Convert this image to 8 bits/pixel
   Dim cmd As New ColorResolutionCommand( _
      ColorResolutionCommandMode.AllPages, _
      8, _
      RasterByteOrder.Rgb, _
      RasterDitheringMethod.None, _
      ColorResolutionCommandPaletteFlags.Optimized, _
      Nothing)
   cmd.Run(image)

   Dim codecs As New RasterCodecs()

   ' Setup the GIF save options
   Dim animationPalette() As RasterColor = image.GetPalette()
   codecs.Options.Gif.Save.SetAnimationPalette(animationPalette)
   codecs.Options.Gif.Save.UseAnimationPalette = True

   ' The GIF Animation width & height, loop and background are
   ' pulled automatically from the image

   ' Save the file
   Dim fileName As String = Path.Combine(LEAD_VARS.ImagesDir, "AnimatedGifFile.gif")
   codecs.Save(image, fileName, RasterImageFormat.Gif, 8, 1, image.PageCount, 1, CodecsSavePageMode.Overwrite)

   image.Dispose()

   codecs.Dispose()
End Sub

Public NotInheritable Class LEAD_VARS
Public Const ImagesDir As String = "C:\Users\Public\Documents\LEADTOOLS Images"
End Class