Gif animation

Télécharger le projet
Commenter

Description

Animer un gif à l'aide d'un ScrollBar et sélectionner une frame et l'enregistrer en bmp, gif et jpeg.
Ajout du code en VBA que j'ai pris sur le site :
http://vb.developpez.com/srcvba/?page=vbaExImage#vbaWIAimage
Je l'ai modifié en faisant une sauvegarde dans le dossier source et en ajoutant le nombre de frames et le N° de la frame enregistrée.

Source / Exemple : 


Public Class Form1
    'Copie de l'image
    Private Declare Function BitBlt Lib "gdi32.dll" ( _
                  ByVal hDestDC As IntPtr, _
                  ByVal x As Int32, _
                  ByVal y As Int32, _
                  ByVal nWidth As Int32, _
                  ByVal nHeight As Int32, _
                  ByVal hSrcDC As IntPtr, _
                  ByVal xSrc As Int32, _
                  ByVal ySrc As Int32, _
                  ByVal dwRop As Int32) As Int32

    Private Const SRCCOPY = &HCC0020
    'Animation
    Private oB As New Bitmap(Application.StartupPath & "\Image002.Gif")
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'On affiche l'image
        Dim oFD As New System.Drawing.Imaging.FrameDimension(oB.FrameDimensionsList(0))
        HScrollBar1.Maximum = oB.GetFrameCount(oFD) - 1
    End Sub
#Region " fonction animation"
    Private Sub HScrollBar1_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles HScrollBar1.Scroll
        Picture.Invalidate()
    End Sub

    Private Sub Picture2_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Picture.Paint
        Dim oFD As New System.Drawing.Imaging.FrameDimension(oB.FrameDimensionsList(0))
        oB.SelectActiveFrame(oFD, HScrollBar1.Value)
        e.Graphics.DrawImage(oB, 0, 0)
    End Sub

    Private Sub HScrollBar1_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles HScrollBar1.MouseHover
        'On affiche le N° de la frame
        Me.ToolTip2.SetToolTip(Me.HScrollBar1, Me.HScrollBar1.Value.ToString + " ème frame")
        Label6.Text = Me.HScrollBar1.Value.ToString + " ème frame"
    End Sub
#End Region
#Region " fonction sauvegarde"
    Private Sub btnsave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnsave.Click
        'Copie de l'image
        Dim oB As New Bitmap(Picture.ClientRectangle.Width, Picture.ClientRectangle.Height)
        Dim gForm As Graphics = Picture.CreateGraphics()
        Dim iHdcForm As IntPtr = gForm.GetHdc()

        Dim gBitmap As Graphics = Graphics.FromImage(oB)
        Dim iHdcBitmap As IntPtr = gBitmap.GetHdc()

        Dim iResultBitBlt As Int32 = BitBlt(iHdcBitmap, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, iHdcForm, 0, 0, SRCCOPY)

        gBitmap.ReleaseHdc(iHdcBitmap)
        gForm.ReleaseHdc(iHdcForm)
        gBitmap.Dispose()
        gForm.Dispose()

        ' Inscrivez le nom du dossier de sauvegarde de l'image.
        Dim file_name As String = Application.ExecutablePath
        file_name = file_name.Substring(0, file_name.LastIndexOf("\bin")) & _
            "\Frame."
        oB.Save(file_name & "bmp", System.Drawing.Imaging.ImageFormat.Bmp)
        oB.Save(file_name & "jpg", System.Drawing.Imaging.ImageFormat.Jpeg)
        oB.Save(file_name & "gif", System.Drawing.Imaging.ImageFormat.Gif)

        MsgBox("La " & Label6.Text & " est sauvegardée dans le dossier Gif Animation en bmp,jpg et gif.")
    End Sub
#End Region
End Class
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Le Pivert)