GIF ANIMATION

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 zip

08 juillet 2008 07:59:24 :

Suppression du chemin en dur grace à l'aide de "Gillardg".

08 juillet 2008 18:58:57 :

Ajout du code en VBA. Toutes les explications sont sur la feuille Excel.

11 juillet 2008 12:11:26 :

En VBA Excel, ajout de la boite de dialogue Windows des propriétés d'un fichier.

11 juillet 2008 12:14:37 :

En VBA EXcel, ajout de la boite de dialogue Windows des propriétés d'un fichier.