[vb.net] Create Animated Gif > vb.net

본문 바로가기

vb.net

[기타] [vb.net] Create Animated Gif

회원사진
하나를하더라도최선을
2022-10-05 16:44 3,056 0

본문



Option Strict Off
Imports System
Imports System.Collections.Generic
Imports System.Diagnostics
Imports System.Text
Imports System.IO
Imports System.Collections
Imports System.Collections.Specialized
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System.Drawing.Image
Imports System.Threading
Imports System.Runtime.Serialization
Imports System.Windows.Forms
Imports System.Windows
Imports System.Runtime.InteropServices
 
Module CreateAnimatedGif
    Dim environ As String = Environment.UserName
    Dim userPath As String = "C:\Users\" & environ & "\Desktop\Animated Gifs\"
    Dim Bitmaps As List(Of Bitmap) = New List(Of Bitmap)
    Dim width As Integer
    Dim height As Integer
    Dim windowRect As New NativeMethods.RECT
    Sub Main()
        'Use WindowCoord subroutine if you want to capture a specific application
        'window, or child window within application.
        'otherwise, leave commented.
        'WindowCoord()
        'Screenshots subroutine will need to be looped based on
        'the amount of time you want to record on-screen actions
        'otherwise it will only take one screenshot.
        'If you are carrying out a specific task, maybe you 
        'can write code to loop the subroutine until the task is completed.
        Screenshots()
        'assemble screenshots into animated GIF
        'Sets certain properties, such as Frame delay and number of times the animation
        'will loop
        AssembleGIF()
 
    End Sub
    Sub WindowCoord()
        Dim MainWindow As IntPtr
        Dim WindowName As String
        Dim count As Integer
        Dim Lstring As Integer
        Dim Rstring As Integer
        'Create a buffer of 256 characters
        Dim Caption As New System.Text.StringBuilder(256)
        For Each p As Process In Process.GetProcesses()
            If p.MainWindowTitle.Contains("Add Window Title Here, or a unique part of it"Then
                WindowName = p.MainWindowTitle
                MainWindow = p.MainWindowHandle
            End If
        Next
        'The following commented code can be used to parse WindowName
        'if you need to get a substring out of the
        'window title
        'it will loop through and look at each character 
        'in the string
        'For Each c As Char In WindowName
        '    count += 1
        '    If c = "[" Then
        '        Lstring = count
        '    ElseIf c = "]" Then
        '        Rstring = count
        '    End If
        'Next
        'WindowName = WindowName.Substring(Lstring, WindowName.Length - Lstring - 1)
        'Enumerate child windows
        For Each child As IntPtr In NativeMethods.GetChildWindows(MainWindow)
            NativeMethods.GetWindowText(child, Caption, Caption.Capacity)
            If Caption.ToString = WindowName Then
                'Get window width, height which will  be used in 
                'Screenshot subroutine
                NativeMethods.GetWindowRect(child, windowRect)
                width = windowRect.right - windowRect.left
                height = windowRect.bottom - windowRect.top
            End If
        Next
    End Sub
    Sub Screenshots()
        Static count As Integer
        'declare variables
        Dim bounds As Rectangle
        Dim screenshot As System.Drawing.Bitmap
        Dim graph As Graphics
        'Use  the following two lines to get screenshot coordinates, used for full screen (screenshot width and height in ratio to screen)
        bounds = Screen.PrimaryScreen.Bounds
        screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppRgb)
        'If you only want to capture a specific application window, or child window you can use the following line of code
        'But you will need to call the WindoCoord Subroutine and enter the specific window title you are looking for
        'screenshot = New System.Drawing.Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format32bppRgb)
        'screen shot quality
        screenshot.SetResolution(300300'dpi
        graph = Graphics.FromImage(screenshot)
        graph.Clear(Color.White)
        graph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        graph.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
        graph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        graph.CopyFromScreen(windowRect.left, windowRect.top, 00New Size(width, height), CopyPixelOperation.SourceCopy)
        graph.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
        'Print text on screenshot
        Using F As New Font("Arial"10)
            'Create a brush
            Using B As New SolidBrush(Color.Black)
                'Draw some text
                graph.DrawString(Now.ToString("yyyy-MM-dd HH:mm:ss fff"), F, B, 2020)
            End Using
        End Using
        'Add screenshot to Bitmaps List for later
        'Assembly and animation
        Dim Bmp As New Bitmap(screenshot)
        Bitmaps.Add(Bmp)
        count += 1
        If count < 5 Then Screenshots()
    End Sub
    Sub AssembleGIF()
#Region "Exsample"
        'Bitmaps.Clear()
        'Bitmaps.Add(New Bitmap("C:\Users\Administrator\OneDrive\문서\카카오톡 받은 파일\요미_0013m.jpg"))
        'Bitmaps.Add(New Bitmap("C:\Users\Administrator\OneDrive\문서\카카오톡 받은 파일\요미_0018m.jpg"))
#End Region
        'GDI+ constants absent from system.drawing
        Const PropertyTagFrameDelay As Integer = &H5100
        Const PropertyTagLoopCount As Integer = &H5101
        Const PropertyTagTypeLong As Short = 4
        Const PropertyTagTypeShort As Short = 3
        Const UIntBytes As Integer = 4
        Dim gifEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Gif)
        Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
        'Parameters of the first frame
        Dim myEncoderParameters1 As New EncoderParameters(1)
        myEncoderParameters1.Param(0= New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.MultiFrame))
        'Parameters of other frames
        Dim myEncoderParametersN = New EncoderParameters(1)
        myEncoderParametersN.Param(0= New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.FrameDimensionTime))
        Dim myEncoderParametersFlush As New EncoderParameters(1)
        myEncoderParametersFlush.Param(0= New EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(EncoderValue.Flush))
        'Property for the frame delay (apparently no other way to create a fresh instance)
        Dim frameDelay As PropertyItem = DirectCast(FormatterServices.GetUninitializedObject(GetType(PropertyItem)), PropertyItem)
        frameDelay.Id = PropertyTagFrameDelay
        frameDelay.Type = PropertyTagTypeLong
        'Length of the value in bytes
        frameDelay.Len = Bitmaps.Count * UIntBytes
        'The value is an array of 4-byte entries: one per frame.
        'Every entry is the frame delay in 1/100-s of a second, in little endian.
        Dim desiredLength = Bitmaps.Count * UIntBytes
        'E.g., here, we're setting the delay of every frame to 1 second.
        frameDelay.Len = desiredLength
        frameDelay.Value = New Byte(desiredLength - 1) {}
        Dim argument As UInteger = 70   '// 딜레이
        Dim frameDelayBytes = BitConverter.GetBytes(argument)
        Dim J As Integer = 0
        For J = LBound(Bitmaps.ToArray) To Bitmaps.Count
            If J < Bitmaps.Count Then
                Array.Copy(frameDelayBytes, 0, frameDelay.Value, J * UIntBytes, UIntBytes)
            Else
                Exit For
            End If
        Next
        'Property Item for the number of animation loops
        Dim loopPropertyItem As PropertyItem = DirectCast(FormatterServices.GetUninitializedObject(GetType(PropertyItem)), PropertyItem)
        loopPropertyItem.Id = PropertyTagLoopCount
        loopPropertyItem.Type = PropertyTagTypeShort
        loopPropertyItem.Len = 1
        'Ensure that the user has a working directory set-up
        'to store the Gif
        If (Not System.IO.Directory.Exists(userPath)) Then
            System.IO.Directory.CreateDirectory(userPath)
        End If
        '0 means to animate forever
        Dim loopArgument As UShort = 0
        loopPropertyItem.Value = BitConverter.GetBytes(loopArgument)
        'Enter name of Gif in FileStream() below. Maybe user Window Title?
        Dim Fstream As FileStream = New FileStream(userPath & "\" & "Enter Name of Gif here" & ".Gif", FileMode.Create)
        Using Fstream
            Dim first As Boolean = True
            Dim firstBitmap As Bitmap = Nothing
            'Bitmaps is a collection of Bitmap instances that'll become gif frames
            For Each bitmap As Bitmap In Bitmaps
                bitmap = ResizeImage(bitmap, New Size(500500))
                If first = True Then
                    firstBitmap = bitmap
                    firstBitmap.SetPropertyItem(frameDelay)
                    firstBitmap.SetPropertyItem(loopPropertyItem)
                    firstBitmap.Save(Fstream, gifEncoder, myEncoderParameters1)
                    first = False
                Else
                    firstBitmap.SaveAdd(bitmap, myEncoderParametersN)
                End If
            Next
            firstBitmap.SaveAdd(myEncoderParametersFlush)
        End Using
    End Sub
 
    Public Function ResizeImage(ByVal bm_source As Image, ByVal s As Size) As Image
        Dim ratioX = CDbl(s.Width) / bm_source.Width
        Dim ratioY = CDbl(s.Height) / bm_source.Height
        Dim ratio = Math.Min(ratioX, ratioY)
        Dim newWidth = CInt((bm_source.Width * ratio))
        Dim newHeight = CInt((bm_source.Height * ratio))
        Dim newImage = New Bitmap(s.Width, s.Height)
 
        Using g = Graphics.FromImage(newImage)
            Dim y As Integer = (s.Height / 2- newHeight / 2
            Dim x As Integer = (s.Width / 2- newWidth / 2
            g.DrawImage(bm_source, x, y, newWidth, newHeight)
        End Using
        Return newImage
    End Function
 
    Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
        Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
        Dim codec As ImageCodecInfo
        For Each codec In codecs
            If codec.FormatID = format.Guid Then
                Return codec
            End If
        Next codec
        Return Nothing
    End Function
End Module
'Windows 32 API functions used to
'get window properties
Public Class NativeMethods
    <DllImport("User32.dll")>
    Private Shared Function EnumChildWindows _
      (ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess,
      ByVal lParam As IntPtr) As Boolean
    End Function
    <StructLayout(LayoutKind.Sequential)>
    Public Structure RECT
        Public left As Integer
        Public top As Integer
        Public right As Integer
        Public bottom As Integer
    End Structure 'RECT
    Public Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
    Public Declare Auto Function GetWindowText Lib "user32" _
             (ByVal hWnd As System.IntPtr,
             ByVal lpString As System.Text.StringBuilder,
             ByVal cch As Integer) As Integer
    Public Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr()
        Dim ChildrenList As New List(Of IntPtr)
        Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)
        Try
            EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle))
        Finally
            If ListHandle.IsAllocated Then ListHandle.Free()
        End Try
        Return ChildrenList.ToArray
    End Function
    Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean
        Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target
        If ChildrenList Is Nothing Then Throw New Exception("GCHandle Target could not be cast as List(Of IntPtr)")
        ChildrenList.Add(Handle)
        Return True
    End Function
End Class



출처:)

h t t p s : / / v b d o t n e t f o r u m s . c o m / t h r e a d s / c r e a t i n g - a n i m a t e d - g i f s . 6 3 6 2 0 /

댓글목록0

등록된 댓글이 없습니다.
게시판 전체검색