158 lines
5.7 KiB
VB.net
158 lines
5.7 KiB
VB.net
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
|
|
|
|
|
|
|
|
Private Sub Form_Load(ByVal sender As Object, ByVal e As EventArgs)
|
|
AddHandler MouseDown, New MouseEventHandler(AddressOf Form_MouseDown)
|
|
End Sub
|
|
|
|
Private Sub Form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown
|
|
If e.Button = MouseButtons.Left Then
|
|
Win32.ReleaseCapture()
|
|
Win32.SendMessage(Handle, Win32.WM_NCLBUTTONDOWN, Win32.HTCAPTION, 0)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_click(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Click
|
|
MsgBox("LOL")
|
|
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
|