VisualBasic.NET 基本图片处理函数

Imports System.Drawing

Namespace GraphicDrawing

    Public Enum PictureFormat
        BMP = 0
        JPEG = 1
        GIF = 2
        PNG = 3
        Emf = 4
        Exif = 5
        Icon = 6
        MemoryBMP = 7
        Tiff = 8
        Wmf = 9
    End Enum
    Public Enum BalloonTipAction
        Add = &H0S
        Delete = &H2S
        Modify = &H1S
        SetFocus = &H3S
        SetVersion = &H4S
    End Enum

    Public Module GraphicDrawing
        ' 关于气球提示的自定义消息, 2000下不产生这些消息

        ' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮,
        ' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。

        Public Structure RGBP
            Dim r As Integer
            Dim g As Integer
            Dim b As Integer
            Sub Reset()
                r = Math.Min(r, 255)
                r = Math.Max(r, 0)
                g = Math.Min(g, 255)
                g = Math.Max(g, 0)
                b = Math.Min(b, 255)
                b = Math.Max(b, 0)
            End Sub
            Sub Dispose()
                r = Nothing
                g = Nothing
                b = Nothing
            End Sub
        End Structure

        Overloads Sub BalloonTip(ByVal frm As Form, ByVal IconData As NOTIFYICONDATA, ByVal Action As BalloonTipAction)
            IconData.hwnd = frm.Handle.ToInt32
            Dim ret As Integer
            ret = Shell_NotifyIcon(Action, IconData)
            If ret = 0 And Action = BalloonTipAction.Add Then
                ret = Shell_NotifyIcon(BalloonTipAction.Modify, IconData)
            ElseIf ret = 0 And Action = BalloonTipAction.Modify Then
                ret = Shell_NotifyIcon(BalloonTipAction.Add, IconData)
            End If
        End Sub
        Overloads Sub BalloonTip(ByVal frm As System.Windows.Forms.Form, ByVal Action As BalloonTipAction, ByVal Tip As String, ByVal TipIcon As System.Drawing.Icon, ByVal msgTitle As String, ByVal msgInfo As String, ByVal msgIcon As NIIFTYPE, Optional ByVal Timeout As Integer = 1000)
            Dim tmp As NOTIFYICONDATA
            InitalNIIF(frm, tmp, Tip, TipIcon, msgTitle, msgInfo, msgIcon, Timeout)
            Dim ret As Integer
            ret = Shell_NotifyIcon(Action, tmp)
            If ret = 0 And Action = BalloonTipAction.Add Then
                ret = Shell_NotifyIcon(BalloonTipAction.Modify, tmp)
            ElseIf ret = 0 And Action = BalloonTipAction.Modify Then
                ret = Shell_NotifyIcon(BalloonTipAction.Add, tmp)
            End If
        End Sub

        Sub InitalNIIF(ByVal Form As System.Windows.Forms.Form, ByRef IconData As NOTIFYICONDATA, ByVal Tip As String, ByVal TipIcon As System.Drawing.Icon, ByVal msgTitle As String, ByVal msgInfo As String, ByVal msgIcon As NIIFTYPE, Optional ByVal Timeout As Integer = 1000)
            With IconData
                .cbSize = Len(IconData)
                .hwnd = Form.Handle.ToInt32
                .uFlags = NIF_TIP or NIF_ICON or NIF_MESSAGE or NIF_INFO or NIF_STATE
                .uCallBackMessage = NIN_BALLOON.WM_NOTIFYICON
                .szTip = Tip & vbNullChar
                .hIcon = TipIcon.Handle.ToInt32
                .dwState = 0
                .dwStateMask = 0
                .szInfo = msgInfo & vbNullChar
                .szInfoTitle = msgTitle & vbNullChar
                .dwInfoFlags = msgIcon
                .uTimeoutOrVersion = Timeout
            End With
        End Sub

        Private Function PictureFormatToImageFormat(ByVal sFormat As PictureFormat) As System.Drawing.Imaging.ImageFormat
            Select Case sFormat
                Case PictureFormat.BMP
                    Return Imaging.ImageFormat.Bmp
                Case PictureFormat.Emf
                    Return Imaging.ImageFormat.Emf
                Case PictureFormat.Exif
                    Return Imaging.ImageFormat.Exif
                Case PictureFormat.GIF
                    Return Imaging.ImageFormat.Gif
                Case PictureFormat.Icon
                    Return Imaging.ImageFormat.Icon
                Case PictureFormat.JPEG
                    Return Imaging.ImageFormat.Jpeg
                Case PictureFormat.MemoryBMP
                    Return Imaging.ImageFormat.MemoryBmp
                Case PictureFormat.PNG
                    Return Imaging.ImageFormat.Png
                Case PictureFormat.Tiff
                    Return Imaging.ImageFormat.Tiff
                Case PictureFormat.Wmf
                    Return Imaging.ImageFormat.Wmf
            End Select
        End Function

        Overloads Sub CaptureScreen(ByVal rectArea As Rectangle, ByVal szFilename As String, ByVal iFormat As PictureFormat)
            Dim myImage As Bitmap
            Dim dc1 As New IntPtr
            dc1 = CreateDC("DISPLAY", "", "", IntPtr.Zero)
            Dim g1 As Graphics
            g1 = g1.FromHdc(dc1)
            myImage = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, g1)
            Dim g2 As Graphics
            g2 = g2.FromImage(myImage)
            dc1 = g1.GetHdc
            Dim dc2 As New IntPtr
            dc2 = g2.GetHdc
            BitBlt(dc2, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, dc1, 0, 0, 13369376)
            g1.ReleaseHdc(dc1)
            g2.ReleaseHdc(dc2)

            Dim tmpImage As New Bitmap(rectArea.Width, rectArea.Height)
            Dim g As Graphics = Graphics.FromImage(tmpImage)
            Dim destRect As Rectangle = New Rectangle(0, 0, rectArea.Width, rectArea.Height)

            g.DrawImage(myImage, destRect, rectArea.Left, rectArea.Top, tmpImage.Width, tmpImage.Height, GraphicsUnit.Pixel)
            myImage = New Bitmap(tmpImage)
            If IO.File.Exists(szFilename) Then IO.File.Delete(szFilename)
            myImage.Save(szFilename, PictureFormatToImageFormat(iFormat))
            g.Dispose()
            g1.Dispose()
            g2.Dispose()
            tmpImage.Dispose()
            myImage.Dispose()
        End Sub
        Overloads Function CaptureScreen(ByVal rectArea As Rectangle) As Image
            Dim myImage As Bitmap
            Dim dc1 As New IntPtr
            dc1 = CreateDC("DISPLAY", "", "", IntPtr.Zero)
            Dim g1 As Graphics
            g1 = g1.FromHdc(dc1)
            myImage = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, g1)
            Dim g2 As Graphics
            g2 = g2.FromImage(myImage)
            dc1 = g1.GetHdc
            Dim dc2 As New IntPtr
            dc2 = g2.GetHdc
            BitBlt(dc2, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, dc1, 0, 0, 13369376)
            g1.ReleaseHdc(dc1)
            g2.ReleaseHdc(dc2)

            Dim tmpImage As New Bitmap(rectArea.Width, rectArea.Height)
            Dim g As Graphics = Graphics.FromImage(tmpImage)
            Dim destRect As Rectangle = New Rectangle(0, 0, rectArea.Width, rectArea.Height)

            g.DrawImage(myImage, destRect, rectArea.Left, rectArea.Top, tmpImage.Width, tmpImage.Height, GraphicsUnit.Pixel)
            myImage = New Bitmap(tmpImage)
            Return myImage
            g.Dispose()
            g1.Dispose()
            g2.Dispose()
            tmpImage.Dispose()
            myImage.Dispose()
        End Function
        Overloads Sub CaptureScreen(ByRef frm As Form, ByVal szFile As String, ByVal iType As PictureFormat)
            Dim myImage As Bitmap
            Dim dc1 As New IntPtr
            dc1 = CreateDC("DISPLAY", "", "", IntPtr.Zero)
            Dim g1 As Graphics
            g1 = g1.FromHdc(dc1)
            myImage = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, g1)
            Dim g2 As Graphics
            g2 = g2.FromImage(myImage)
            dc1 = g1.GetHdc
            Dim dc2 As New IntPtr
            dc2 = g2.GetHdc
            BitBlt(dc2, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, dc1, 0, 0, 13369376)
            g1.ReleaseHdc(dc1)
            g2.ReleaseHdc(dc2)
            Dim rectArea As Rectangle
            rectArea = frm.Bounds
            Dim tmpImage As New Bitmap(rectArea.Width, rectArea.Height)
            Dim g As Graphics = Graphics.FromImage(tmpImage)
            Dim destRect As Rectangle = New Rectangle(0, 0, rectArea.Width, rectArea.Height)

            g.DrawImage(myImage, destRect, rectArea.Left, rectArea.Top, tmpImage.Width, tmpImage.Height, GraphicsUnit.Pixel)
            myImage = New Bitmap(tmpImage)
            g.Dispose()
            g1.Dispose()
            g2.Dispose()
            tmpImage.Dispose()
            myImage.Dispose()
        End Sub
        Sub SaveImage(ByVal srcImage As Image, ByVal Filename As String, ByVal iFormat As PictureFormat)
            If Not (srcImage Is Nothing) Then
                srcImage.Save(Filename, PictureFormatToImageFormat(iFormat))
            End If
        End Sub

        Function LoadPicInExe(ByVal Exe As String, ByVal Index As Integer) As Icon
            Dim hIcon As Integer = ExtractIcon(0, Exe, Index)
            Dim k As Icon
            k = k.FromHandle(New IntPtr(hIcon))
            Return k
        End Function

        Sub ConvertRect(ByRef OldRect As Rectangle)
            Dim tmpRect As Rectangle
            If OldRect.Width < 0 Then
                tmpRect.Width = Math.Abs(OldRect.Width)
                OldRect.X = OldRect.X - tmpRect.Width
                OldRect.Width = tmpRect.Width
            End If
            If OldRect.Height < 0 Then
                tmpRect.Height = Math.Abs(OldRect.Height)
                OldRect.Y = OldRect.Y - tmpRect.Height
                OldRect.Height = tmpRect.Height
            End If
        End Sub
        Function RECTtoRectangle(ByVal sRECT As RECT) As Rectangle
            Dim k As New Rectangle(sRECT.Left, sRECT.Top, sRECT.Right - sRECT.Left, sRECT.Bottom - sRECT.Right)
            ConvertRect(k)
            Return k
        End Function

        ReadOnly Property ScreenWidth() As Integer
            Get
                Return Screen.PrimaryScreen.Bounds.Width
            End Get
        End Property
        ReadOnly Property ScreenHeight() As Integer
            Get
                Return Screen.PrimaryScreen.Bounds.Height
            End Get
        End Property

        Function GetImageRGB(ByVal srcImage As Image) As RGBP(,)
            Dim tmpColor As Color
            Dim tmpBitmap As Bitmap = srcImage.Clone
            Dim w, h, i, j As Integer
            w = tmpBitmap.Width : h = tmpBitmap.Height
            Dim rgbpoint(w, h) As RGBP
            For i = 0 To w - 1
                For j = 0 To h - 1
                    tmpColor = tmpBitmap.GetPixel(i, j)
                    rgbpoint(i, j).r = tmpColor.R
                    rgbpoint(i, j).g = tmpColor.G
                    rgbpoint(i, j).b = tmpColor.B
                Next
            Next
            Return rgbpoint
            tmpColor = Nothing
            tmpBitmap.Dispose()
            rgbpoint = Nothing
        End Function

        Function SmoothImage(ByVal srcImage As Image) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            For i = 1 To w - 2
                For j = 1 To h - 2
                    tmprgbp.r = _
                    (oldrgbp(i - 1, j - 1).r + oldrgbp(i - 1, j).r + oldrgbp(i - 1, j + 1).r _
                    + oldrgbp(i, j - 1).r + oldrgbp(i, j).r + oldrgbp(i, j + 1).r _
                    + oldrgbp(i + 1, j - 1).r + oldrgbp(i + 1, j).r + oldrgbp(i + 1, j + 1).r) \ 9
                    tmprgbp.g = _
                    (oldrgbp(i - 1, j - 1).g + oldrgbp(i - 1, j).g + oldrgbp(i - 1, j + 1).g _
                    + oldrgbp(i, j - 1).g + oldrgbp(i, j).g + oldrgbp(i, j + 1).g _
                    + oldrgbp(i + 1, j - 1).g + oldrgbp(i + 1, j).g + oldrgbp(i + 1, j + 1).g) \ 9
                    tmprgbp.b = _
                    (oldrgbp(i - 1, j - 1).b + oldrgbp(i - 1, j).b + oldrgbp(i - 1, j + 1).b _
                    + oldrgbp(i, j - 1).b + oldrgbp(i, j).b + oldrgbp(i, j + 1).b _
                    + oldrgbp(i + 1, j - 1).b + oldrgbp(i + 1, j).b + oldrgbp(i + 1, j + 1).b) \ 9
                    newBitmap.SetPixel(i, j, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap())
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function SharpImage(ByVal srcImage As Image, Optional ByVal Power As Single = 0.5) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            For i = 1 To w - 2
                For j = 1 To h - 2
                    tmprgbp.r = CType(oldrgbp(i, j).r + Math.Abs(oldrgbp(i - 1, j).r - oldrgbp(i - 1, j - 1).r) * Power, Integer)
                    tmprgbp.g = CType(oldrgbp(i, j).g + Math.Abs(oldrgbp(i - 1, j).g - oldrgbp(i - 1, j - 1).g) * Power, Integer)
                    tmprgbp.b = CType(oldrgbp(i, j).b + Math.Abs(oldrgbp(i - 1, j).b - oldrgbp(i - 1, j - 1).b) * Power, Integer)
                    tmprgbp.Reset()
                    newBitmap.SetPixel(i, j, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function EmbossmentImage(ByVal srcImage As Image, Optional ByVal Power As Byte = 128) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            For i = 1 To w - 2
                For j = 1 To h - 2
                    tmprgbp.r = Math.Abs(oldrgbp(i, j).r - oldrgbp(i + 1, j + 1).r + Power)
                    tmprgbp.g = Math.Abs(oldrgbp(i, j).g - oldrgbp(i + 1, j + 1).g + Power)
                    tmprgbp.b = Math.Abs(oldrgbp(i, j).b - oldrgbp(i + 1, j + 1).b + Power)
                    tmprgbp.Reset()
                    newBitmap.SetPixel(i, j, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function GrayImage(ByVal srcImage As Image, Optional ByVal p1 As Single = 0.299, Optional ByVal p2 As Single = 0.578, Optional ByVal p3 As Single = 0.114) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            For i = 0 To w - 1
                For j = 0 To h - 1
                    tmprgbp.r = oldrgbp(i, j).r * p1 + oldrgbp(i, j).g * p2 + oldrgbp(i, j).b * p3
                    tmprgbp.g = tmprgbp.r
                    tmprgbp.b = tmprgbp.r
                    tmprgbp.Reset()
                    newBitmap.SetPixel(i, j, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function ResolutionImage(ByVal srcImage As Image, ByVal newWidth As Integer, ByVal newHeight As Integer) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            Dim ws As Integer = w \ newWidth
            Dim hs As Integer = h \ newHeight
            For i = 1 To w - ws + 1 Step ws
                For j = 1 To h - 1
                    tmprgbp.r = oldrgbp(i, j).r
                    tmprgbp.g = oldrgbp(i, j).g
                    tmprgbp.b = oldrgbp(i, j).b
                    Dim k, l As Int16
                    For k = i To i + ws - 2
                        For l = j To j + ws - 2
                            newBitmap.SetPixel(k, l, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                        Next
                    Next
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function InvertImage(ByVal srcImage As Image) As Image
            Dim oldrgbp(,) As RGBP = GetImageRGB(srcImage)
            Dim i, j, w, h As Integer
            w = srcImage.Width : h = srcImage.Height
            Dim newBitmap As New Bitmap(w, h)
            Dim tmprgbp As RGBP
            For i = 1 To w - 1
                For j = 1 To h - 1
                    tmprgbp.r = 255 - oldrgbp(i, j).r
                    tmprgbp.g = 255 - oldrgbp(i, j).g
                    tmprgbp.b = 255 - oldrgbp(i, j).b
                    newBitmap.SetPixel(i, j, Color.FromArgb(tmprgbp.r, tmprgbp.g, tmprgbp.b))
                Next
            Next
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
            oldrgbp = Nothing
            tmprgbp = Nothing
        End Function
        Function Transparence(ByVal srcImage As Image, ByVal transColor As Color) As Image
            Dim newBitmap As Bitmap = srcImage.Clone
            newBitmap.MakeTransparent(transColor)
            Return Image.FromHbitmap(newBitmap.GetHbitmap)
            newBitmap.Dispose()
        End Function
    End Module
End Namespace