Modules/GUIs.ZooFlow/ClassFlowForm.vb

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Class Win32
    Public Enum Bool
        [False] = 0
        [True]
    End Enum

    <StructLayout(LayoutKind.Sequential)>
    Public Structure Point
        Public x As Int32
        Public y As Int32

        Public Sub New(ByVal x As Int32, ByVal y As Int32)
            Me.x = x
            Me.y = y
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential)>
    Public Structure Size
        Public cx As Int32
        Public cy As Int32

        Public Sub New(ByVal cx As Int32, ByVal cy As Int32)
            Me.cx = cx
            Me.cy = cy
        End Sub
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Structure ARGB
        Public Blue As Byte
        Public Green As Byte
        Public Red As Byte
        Public Alpha As Byte
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Public Structure BLENDFUNCTION
        Public BlendOp As Byte
        Public BlendFlags As Byte
        Public SourceConstantAlpha As Byte
        Public AlphaFormat As Byte
    End Structure

    Public Const ULW_COLORKEY As Int32 = &H1
    Public Const ULW_ALPHA As Int32 = &H2
    Public Const ULW_OPAQUE As Int32 = &H4
    Public Const AC_SRC_OVER As Byte = &H0
    Public Const AC_SRC_ALPHA As Byte = &H1

    Public Const WM_NCLBUTTONDOWN As Integer = &HA1
    Public Const HTCAPTION As Integer = &H2

    <DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function UpdateLayeredWindow(ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool
    End Function
    <DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
    End Function
    <DllImport("user32.dll", ExactSpelling:=True)>
    Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr
    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function DeleteDC(ByVal hdc As IntPtr) As Bool
    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True)>
    Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Bool
    End Function
    <DllImport("User32.dll")>
    Public Shared Function ReleaseCapture() As Boolean
    End Function
    <DllImport("User32.dll")>
    Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

End Class

Public Class ClassFlowForm
    Inherits Form
    Public Sub New()
        FormBorderStyle = FormBorderStyle.None
        TopMost = True
    End Sub

    Public Sub SetBitmap(ByVal bitmap As Bitmap)
        SetBitmap(bitmap, 255, bitmap.Width, bitmap.Height)
    End Sub

    Public Sub SetBitmap(ByVal Bitmap As Bitmap, ByVal Opacity As Byte, ByVal Width As Integer, ByVal Height As Integer)
        If Bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
            Throw New ApplicationException("The bitmap must be 32ppp with alpha-channel.")
        End If

        Dim oScreenDeviceContext As IntPtr = Win32.GetDC(IntPtr.Zero)
        Dim oMemoryDeviceContext As IntPtr = Win32.CreateCompatibleDC(oScreenDeviceContext)
        Dim oBitmap As IntPtr = IntPtr.Zero
        Dim oOldBitmap As IntPtr = IntPtr.Zero

        Try
            oBitmap = Bitmap.GetHbitmap(Color.FromArgb(0))
            oOldBitmap = Win32.SelectObject(oMemoryDeviceContext, oBitmap)
            Dim oSize As Win32.Size = New Win32.Size(Width, Height)
            Dim oPointSource As Win32.Point = New Win32.Point(0, 0)
            Dim oTopPos As Win32.Point = New Win32.Point(Left, Top)
            Dim oBlend As Win32.BLENDFUNCTION = New Win32.BLENDFUNCTION With {
                .BlendOp = Win32.AC_SRC_OVER,
                .BlendFlags = 0,
                .SourceConstantAlpha = Opacity,
                .AlphaFormat = Win32.AC_SRC_ALPHA
            }
            Win32.UpdateLayeredWindow(Handle, oScreenDeviceContext, oTopPos, oSize, oMemoryDeviceContext, oPointSource, 0, oBlend, Win32.ULW_ALPHA)
        Finally
            Win32.ReleaseDC(IntPtr.Zero, oScreenDeviceContext)

            If oBitmap <> IntPtr.Zero Then
                Win32.SelectObject(oMemoryDeviceContext, oOldBitmap)
                Win32.DeleteObject(oBitmap)
            End If

            Win32.DeleteDC(oMemoryDeviceContext)
        End Try
    End Sub

    Protected Overrides ReadOnly Property CreateParams As CreateParams
        Get
            Dim oParams As CreateParams = MyBase.CreateParams
            oParams.ExStyle = oParams.ExStyle Or &H80000
            Return oParams
        End Get
    End Property
End Class