Imports System.Runtime.InteropServices

Public Class RegionForm
    Inherits SingleLayeredForm
    Private StartX, StartY, EndX, EndY As Integer, IsDrawing As Boolean = False
    Private FillBrush As New SolidBrush(Color.FromArgb(200, Color.Orange))

    Sub New()
        Location = GetStartPoint()
        Size = GetSize()

        TopMost = True
        _ClickThrought = False
    End Sub

    Private Function GetStartPoint() As Point
        For Each Screen As Screen In Screen.AllScreens
            GetStartPoint.X = If(Screen.Bounds.X < GetStartPoint.X, Screen.Bounds.X, GetStartPoint.X)
            GetStartPoint.Y = If(Screen.Bounds.Y < GetStartPoint.Y, Screen.Bounds.Y, GetStartPoint.Y)
        Next
    End Function

    Private Function GetSize() As Size
        For Each Screen As Screen In Screen.AllScreens
            GetSize.Height += If(Screen.Bounds.Height > GetSize.Height, Screen.Bounds.Height, GetSize.Height)
            GetSize.Width += Screen.Bounds.Width
        Next
    End Function


    Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs)
        StartX = e.X : StartY = e.Y
        IsDrawing = True
    End Sub
    Protected Overrides Sub OnMouseUp(e As System.Windows.Forms.MouseEventArgs)
        IsDrawing = False
    End Sub

    Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
        If Not IsDrawing Then Exit Sub

        EndX = e.X : EndY = e.Y
        Invalidate()
    End Sub

    Private Fnt As New Font("Verdana", 20)
    Private Sub RegionForm_Paint(G As System.Drawing.Graphics) Handles Me.Paint
        Dim Watch = Stopwatch.StartNew

        Dim region = New Rectangle(Math.Min(StartX, EndX), Math.Min(StartY, EndY), Math.Abs(StartX - EndX), Math.Abs(StartY - EndY))
        G.FillRectangle(FillBrush, region)

        ' Draw the FPS
        Dim str As String = Math.Round(1000 / Watch.ElapsedMilliseconds, 0) & " FPS"
        Dim sF = G.MeasureString(str, Fnt)
        G.FillRectangle(Brushes.White, 0, 0, sF.Width, sF.Height)
        G.DrawString(str, Fnt, Brushes.Black, New Point)
    End Sub
End Class

Public Class SingleLayeredForm
    Inherits Form
    Protected _ClickThrought As Boolean

#Region " API Stuff "
    Private Const AC_SRC_OVER As Byte = 0
    Private Const AC_SRC_ALPHA As Byte = 1
    Private Const ULW_ALPHA As Int32 = 2

    Private Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (hDC As IntPtr) As IntPtr
    Private Declare Auto Function GetDC Lib "user32.dll" (hWnd As IntPtr) As IntPtr

    <DllImport("gdi32.dll", ExactSpelling:=True)> _
    Private Shared Function SelectObject(hDC As IntPtr, hObj As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", ExactSpelling:=True)> _
    Private Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer
    End Function

    Private Declare Auto Function DeleteDC Lib "gdi32.dll" (hDC As IntPtr) As Integer
    Private Declare Auto Function DeleteObject Lib "gdi32.dll" (hObj As IntPtr) As Integer
    Private Declare Auto Function UpdateLayeredWindow Lib "user32.dll" (hwnd As IntPtr, hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, hdcSrc As IntPtr, ByRef pptSrc As Point, crKey As Int32, ByRef pblend As BLENDFUNCTION, dwFlags As Int32) As Integer
    Private Declare Auto Function ExtCreateRegion Lib "gdi32.dll" (lpXform As IntPtr, nCount As UInteger, rgnData As IntPtr) As IntPtr

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

        Public Sub New(x As Int32, y As Int32)
            cx = x
            cy = y
        End Sub
    End Structure

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

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

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

        Public Shared Operator +(x As Point, y As Point) As Point
            Return New Point(x.x + y.x, x.y + y.y)
        End Operator

    End Structure
#End Region

    Sub New(Optional ByVal ClickThrought As Boolean = True)
        SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
        FormBorderStyle = Windows.Forms.FormBorderStyle.None
        StartPosition = FormStartPosition.Manual
        _ClickThrought = ClickThrought
    End Sub

    'WS_EX_LAYERED, WS_EX_TRANSPARENT
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cParms As CreateParams = MyBase.CreateParams
            cParms.ExStyle = cParms.ExStyle Or &H80000
            If _ClickThrought Then cParms.ExStyle = cParms.ExStyle Or &H20

            Return cParms
        End Get
    End Property

    Public Sub SetBits(B As Drawing.Bitmap, Optional ByVal p As Drawing.Point = Nothing)
        If Not IsHandleCreated Or DesignMode Then Exit Sub

        Dim oldBits As IntPtr = IntPtr.Zero
        Dim screenDC As IntPtr = GetDC(IntPtr.Zero)
        Dim hBitmap As IntPtr = IntPtr.Zero
        Dim memDc As IntPtr = CreateCompatibleDC(screenDC)

        Try
            Dim topLoc As New Point(Left, Top)
            If Not IsNothing(p) Then topLoc += New Point(p.X, p.Y)

            Dim bitMapSize As New Size(B.Width, B.Height)
            Dim blendFunc As New BLENDFUNCTION()
            Dim srcLoc As New Point(0, 0)

            hBitmap = B.GetHbitmap(Drawing.Color.FromArgb(0))
            oldBits = SelectObject(memDc, hBitmap)

            blendFunc.BlendOp = AC_SRC_OVER
            blendFunc.SourceConstantAlpha = 255
            blendFunc.AlphaFormat = AC_SRC_ALPHA
            blendFunc.BlendFlags = 0

            UpdateLayeredWindow(Handle, screenDC, topLoc, bitMapSize, memDc, srcLoc, _
             0, blendFunc, ULW_ALPHA)
        Finally
            If hBitmap <> IntPtr.Zero Then
                SelectObject(memDc, oldBits)
                DeleteObject(hBitmap)
            End If
            ReleaseDC(IntPtr.Zero, screenDC)
            DeleteDC(memDc)
        End Try
    End Sub

    Public Shadows Sub Invalidate()
        Dim B As New Drawing.Bitmap(ClientSize.Width, ClientSize.Height)
        Dim G As Drawing.Graphics = Drawing.Graphics.FromImage(B) : G.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias

        RaiseEvent Paint(G)

        G.Dispose()
        SetBits(B)
        B.Dispose()
    End Sub

    Public Shadows Event Paint(G As Drawing.Graphics)
End Class