Lnguage: VB net (NetFramework 4.0) (will work in NetFramework 3.5 or before)
To make Forms with Custom Appearance, but standard Behaviour This program use the following dll:
With Windows API in the dll, Program will use the following method/function:
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Partial Public Class Form1
Public Sub New()
InitializeComponent()
AddPaintHandlers(Me)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
If Not Me.DesignMode Then
cp.ExStyle = cp.ExStyle Or NativeMethods.WS_EX_LAYERED
End If
Return cp
End Get
End Property
Protected Overrides Sub CreateHandle()
MyBase.CreateHandle()
'Disable VisualStyles as we're doing all painting ourselves.
If OSFeature.Feature.IsPresent(OSFeature.Themes) Then
NativeMethods.SetWindowTheme(Me.Handle, Nothing, "")
End If
End Sub
Protected Overrides Sub OnResize(ByVal e As EventArgs)
MyBase.OnResize(e)
If Me.Created Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnLocationChanged(ByVal e As EventArgs)
MyBase.OnLocationChanged(e)
If Me.Created Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnVisibleChanged(ByVal e As EventArgs)
MyBase.OnVisibleChanged(e)
If Me.Visible Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnScroll(ByVal se As ScrollEventArgs)
MyBase.OnScroll(se)
If (Me.Created) Then
Me.UpdateWindow()
End If
End Sub
Private Sub AddPaintHandlers(ByVal control As Control)
For Each ctl As Control In control.Controls
AddHandler ctl.MouseEnter, AddressOf ctl_Paint
AddHandler ctl.MouseLeave, AddressOf ctl_Paint
AddHandler ctl.MouseDown, AddressOf ctl_Paint
AddHandler ctl.MouseUp, AddressOf ctl_Paint
AddHandler ctl.MouseMove, AddressOf ctl_Paint
AddPaintHandlers(ctl)
Next
End Sub
Private Sub ctl_Paint(ByVal sender As Object, ByVal e As EventArgs)
Me.UpdateWindow()
End Sub
Public Sub UpdateWindow()
If (Me.IsDisposed OrElse Me.Width <= 0 OrElse Me.Height <= 0) Then
Return
End If
Using backBuffer As New Bitmap(Me.Width, Me.Height, PixelFormat.Format32bppPArgb)
Using gr As Graphics = Graphics.FromImage(backBuffer)
gr.SmoothingMode = SmoothingMode.AntiAlias
Dim pt As Point = Me.PointToScreen(Point.Empty)
pt.Offset(-Me.Left, -Me.Top)
Dim rc As Rectangle = Me.RectangleToScreen(Me.ClientRectangle)
rc.Offset(-Me.Left, -Me.Top)
If Me.ClientSize.Width > 0 AndAlso Me.ClientSize.Height > 0 Then
'Paint the ClientArea
Using backBrush As New SolidBrush(Color.FromArgb(128, SystemColors.Control))
gr.FillRectangle(backBrush, rc)
End Using
'Allow for AutoScroll behaviour
Using clientBuffer As New Bitmap(Me.DisplayRectangle.Width, Me.DisplayRectangle.Height, PixelFormat.Format32bppPArgb)
Dim pos As Point = Me.AutoScrollPosition
'Paint the Controls
For Each ctl As Control In Me.Controls
Dim rcCtl As Rectangle = ctl.Bounds
rcCtl.Offset(-pos.X, -pos.Y)
ctl.DrawToBitmap(clientBuffer, rcCtl)
Next
gr.DrawImage(clientBuffer, New Rectangle(rc.Location, Me.ClientSize), New Rectangle(New Point(-pos.X, -pos.Y), Me.ClientSize), GraphicsUnit.Pixel)
End Using
End If
'Paint the NonClientArea
gr.SetClip(rc, CombineMode.Exclude)
gr.FillPath(Brushes.CornflowerBlue, Me.CreateFormShape())
If Me.WindowState <> FormWindowState.Minimized Then
Using scrollFont As New Font("Marlett", SystemInformation.VerticalScrollBarArrowHeight, FontStyle.Regular, GraphicsUnit.Pixel)
Using sf As New StringFormat()
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
'Paint any scrollbars
If Me.HScroll Then
Dim hScrollRect As Rectangle = Me.RectangleToScreen(New Rectangle(0, Me.ClientSize.Height, Me.ClientSize.Width, SystemInformation.HorizontalScrollBarHeight))
hScrollRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Aqua, hScrollRect)
Dim thumbRect As Rectangle = New Rectangle(hScrollRect.X, hScrollRect.Y, hScrollRect.Height, hScrollRect.Height)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("3", scrollFont, Brushes.White, thumbRect)
Dim sbi As New NativeMethods.SCROLLBARINFO()
sbi.cbSize = Marshal.SizeOf(sbi)
NativeMethods.GetScrollBarInfo(Me.Handle, NativeMethods.OBJID_HSCROLL, sbi)
thumbRect = Me.RectangleToScreen(Rectangle.FromLTRB(sbi.xyThumbTop, Me.ClientRectangle.Bottom + 1, sbi.xyThumbBottom, Me.ClientRectangle.Bottom + hScrollRect.Height + 1))
thumbRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Red, thumbRect)
thumbRect = New Rectangle(hScrollRect.Right - hScrollRect.Height, hScrollRect.Y, hScrollRect.Height, hScrollRect.Height)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("4", scrollFont, Brushes.White, thumbRect)
End If
If (Me.VScroll) Then
Dim vScrollRect As Rectangle = Me.RectangleToScreen(New Rectangle(Me.ClientSize.Width, 0, SystemInformation.VerticalScrollBarWidth, Me.ClientSize.Height))
vScrollRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Aqua, vScrollRect)
Dim thumbRect As Rectangle = New Rectangle(vScrollRect.X, vScrollRect.Y, vScrollRect.Width, vScrollRect.Width)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("5", scrollFont, Brushes.White, thumbRect)
Dim sbi As New NativeMethods.SCROLLBARINFO()
sbi.cbSize = Marshal.SizeOf(sbi)
NativeMethods.GetScrollBarInfo(Me.Handle, NativeMethods.OBJID_VSCROLL, sbi)
thumbRect = Me.RectangleToScreen(Rectangle.FromLTRB(Me.ClientRectangle.Right + 1, sbi.xyThumbTop, Me.ClientRectangle.Right + vScrollRect.Width + 1, sbi.xyThumbBottom))
thumbRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Red, thumbRect)
thumbRect = New Rectangle(vScrollRect.X, vScrollRect.Bottom - vScrollRect.Width, vScrollRect.Width, vScrollRect.Width)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("6", scrollFont, Brushes.White, thumbRect)
End If
'Paint the Caption Buttons
Dim buttonSize As Size = SystemInformation.SmallCaptionButtonSize
buttonSize.Width -= 3
Dim buttonRect As Rectangle = New Rectangle(Me.Width - buttonSize.Width - 5, 5, buttonSize.Width, buttonSize.Height)
gr.FillEllipse(Brushes.Red, buttonRect)
buttonRect.Offset(-buttonRect.Width - 2, 0)
gr.FillEllipse(Brushes.Orange, buttonRect)
buttonRect.Offset(-buttonRect.Width - 2, 0)
gr.FillEllipse(Brushes.Yellow, buttonRect)
'Paint the Caption String
sf.Alignment = StringAlignment.Near
sf.Trimming = StringTrimming.EllipsisCharacter
gr.DrawString(Me.Text, SystemFonts.CaptionFont, Brushes.White, RectangleF.FromLTRB(3, buttonRect.Top, buttonRect.Left, buttonRect.Bottom), sf)
End Using
End Using
gr.ResetClip()
End If
End Using
'Use Interop to transfer the bitmap to the screen.
Dim screenDC As IntPtr = NativeMethods.GetDC(IntPtr.Zero)
Dim memDC As IntPtr = NativeMethods.CreateCompatibleDC(screenDC)
Dim hBitmap As IntPtr = backBuffer.GetHbitmap(Color.FromArgb(0))
Dim oldBitmap As IntPtr = NativeMethods.SelectObject(memDC, hBitmap)
Dim blend As New NativeMethods.BLENDFUNCTION(255)
Dim ptDst As Point = Me.Location
Dim szDst As Size = backBuffer.Size
Dim ptSrc As Point = Point.Empty
NativeMethods.UpdateLayeredWindow(Me.Handle, screenDC, ptDst, szDst, memDC, ptSrc, 0, blend, NativeMethods.ULW_ALPHA)
NativeMethods.SelectObject(memDC, oldBitmap)
NativeMethods.DeleteObject(hBitmap)
NativeMethods.DeleteDC(memDC)
NativeMethods.DeleteDC(screenDC)
End Using
End Sub
Private Function CreateFormShape() As GraphicsPath
Dim formShape As GraphicsPath = New GraphicsPath()
formShape.AddArc(0, 0, 12, 12, 180, 90)
formShape.AddArc(Me.Width - 13, 0, 12, 12, 270, 90)
formShape.AddLine(Me.Width - 1, 12, Me.Width - 1, Me.Height - 1)
formShape.AddLine(Me.Width - 1, Me.Height - 1, 0, Me.Height - 1)
formShape.CloseFigure()
Return formShape
End Function
End Class
Public Class NativeMethods
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function UpdateLayeredWindow(ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pptSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Boolean
End Function
<DllImport("uxtheme.dll")> _
Friend Shared Function SetWindowTheme(ByVal hwnd As IntPtr, ByVal pszSubAppName As String, ByVal pszSubIdList As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function CreateCompatibleDC(ByVal dc As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hObj As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function DeleteDC(ByVal dc As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function DeleteObject(ByVal hObj As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function GetScrollBarInfo(ByVal hwnd As IntPtr, ByVal idObject As Int32, ByRef psbi As SCROLLBARINFO) As Boolean
End Function
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Friend Structure BLENDFUNCTION
Public BlendOp, BlendFlags, SourceConstantAlpha, AlphaFormat As Byte
Public Sub New(ByVal alpha As Byte)
Me.BlendOp = AC_SRC_OVER
Me.BlendFlags = 0
Me.SourceConstantAlpha = alpha
Me.AlphaFormat = AC_SRC_ALPHA
End Sub
End Structure
<StructLayout(LayoutKind.Sequential)> _
Friend Structure SCROLLBARINFO
Public cbSize As Int32
Public rcScrollBar As RECT
Public dxyLineButton, xyThumbTop, xyThumbBottom, reserved As Int32
Public scrollbar, incbtn, pgup, thumb, pgdn, decbtn As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
Friend Structure RECT
Public Left, Top, Right, Bottom As Int32
End Structure
Friend Const AC_SRC_OVER As Int32 = &H0
Friend Const AC_SRC_ALPHA As Int32 = &H1
Friend Const ULW_ALPHA As Int32 = &H2
Friend Const WS_EX_LAYERED As Int32 = &H80000
Friend Const OBJID_HSCROLL As Int32 = &HFFFFFFFA '-6
Friend Const OBJID_VSCROLL As Int32 = &HFFFFFFFB '-5
End Class
This Program uses a Layered Window so that all drawing is done by you, including that of child controls. This type of window will never recieve or respond to a standard Paint message.
Advantages of this method include the ability to draw the Scrollbars in any style you wish as well as having the ability to change Alpha levels on a pixel by pixel basis. Just be aware that if you set alpha to zero, then the mouse events will fall through to the window below.
A disadvantage to this method is that not all child windows support DrawToBitmap() and so will not render themselves correctly with the simple UpdateWindow() method used here.
You will need to expand the code to paint the window differently depending upon window focus and mouse position, but adding non client mouse handling is beyond the scope of this simple example. You may call UpdateWindow() whenever the Form or one of it's child controls needs repainting.
DOWNLOAD PROJECT VB NET HERE!
by: Klampok_Child | Original Source Code by: http://dotnetrix.co.uk
To make Forms with Custom Appearance, but standard Behaviour This program use the following dll:
- user32.dll
- uxtheme.dll
- gdi32.dll
With Windows API in the dll, Program will use the following method/function:
- CreateCompatibleDC
- UpdateLayeredWindow
- DeleteDC
- DeleteObject
- GetDC
- GetScrollBarInfo
- SelectObject
- SetWindowTheme
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Partial Public Class Form1
Public Sub New()
InitializeComponent()
AddPaintHandlers(Me)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
If Not Me.DesignMode Then
cp.ExStyle = cp.ExStyle Or NativeMethods.WS_EX_LAYERED
End If
Return cp
End Get
End Property
Protected Overrides Sub CreateHandle()
MyBase.CreateHandle()
'Disable VisualStyles as we're doing all painting ourselves.
If OSFeature.Feature.IsPresent(OSFeature.Themes) Then
NativeMethods.SetWindowTheme(Me.Handle, Nothing, "")
End If
End Sub
Protected Overrides Sub OnResize(ByVal e As EventArgs)
MyBase.OnResize(e)
If Me.Created Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnLocationChanged(ByVal e As EventArgs)
MyBase.OnLocationChanged(e)
If Me.Created Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnVisibleChanged(ByVal e As EventArgs)
MyBase.OnVisibleChanged(e)
If Me.Visible Then
UpdateWindow()
End If
End Sub
Protected Overrides Sub OnScroll(ByVal se As ScrollEventArgs)
MyBase.OnScroll(se)
If (Me.Created) Then
Me.UpdateWindow()
End If
End Sub
Private Sub AddPaintHandlers(ByVal control As Control)
For Each ctl As Control In control.Controls
AddHandler ctl.MouseEnter, AddressOf ctl_Paint
AddHandler ctl.MouseLeave, AddressOf ctl_Paint
AddHandler ctl.MouseDown, AddressOf ctl_Paint
AddHandler ctl.MouseUp, AddressOf ctl_Paint
AddHandler ctl.MouseMove, AddressOf ctl_Paint
AddPaintHandlers(ctl)
Next
End Sub
Private Sub ctl_Paint(ByVal sender As Object, ByVal e As EventArgs)
Me.UpdateWindow()
End Sub
Public Sub UpdateWindow()
If (Me.IsDisposed OrElse Me.Width <= 0 OrElse Me.Height <= 0) Then
Return
End If
Using backBuffer As New Bitmap(Me.Width, Me.Height, PixelFormat.Format32bppPArgb)
Using gr As Graphics = Graphics.FromImage(backBuffer)
gr.SmoothingMode = SmoothingMode.AntiAlias
Dim pt As Point = Me.PointToScreen(Point.Empty)
pt.Offset(-Me.Left, -Me.Top)
Dim rc As Rectangle = Me.RectangleToScreen(Me.ClientRectangle)
rc.Offset(-Me.Left, -Me.Top)
If Me.ClientSize.Width > 0 AndAlso Me.ClientSize.Height > 0 Then
'Paint the ClientArea
Using backBrush As New SolidBrush(Color.FromArgb(128, SystemColors.Control))
gr.FillRectangle(backBrush, rc)
End Using
'Allow for AutoScroll behaviour
Using clientBuffer As New Bitmap(Me.DisplayRectangle.Width, Me.DisplayRectangle.Height, PixelFormat.Format32bppPArgb)
Dim pos As Point = Me.AutoScrollPosition
'Paint the Controls
For Each ctl As Control In Me.Controls
Dim rcCtl As Rectangle = ctl.Bounds
rcCtl.Offset(-pos.X, -pos.Y)
ctl.DrawToBitmap(clientBuffer, rcCtl)
Next
gr.DrawImage(clientBuffer, New Rectangle(rc.Location, Me.ClientSize), New Rectangle(New Point(-pos.X, -pos.Y), Me.ClientSize), GraphicsUnit.Pixel)
End Using
End If
'Paint the NonClientArea
gr.SetClip(rc, CombineMode.Exclude)
gr.FillPath(Brushes.CornflowerBlue, Me.CreateFormShape())
If Me.WindowState <> FormWindowState.Minimized Then
Using scrollFont As New Font("Marlett", SystemInformation.VerticalScrollBarArrowHeight, FontStyle.Regular, GraphicsUnit.Pixel)
Using sf As New StringFormat()
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
'Paint any scrollbars
If Me.HScroll Then
Dim hScrollRect As Rectangle = Me.RectangleToScreen(New Rectangle(0, Me.ClientSize.Height, Me.ClientSize.Width, SystemInformation.HorizontalScrollBarHeight))
hScrollRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Aqua, hScrollRect)
Dim thumbRect As Rectangle = New Rectangle(hScrollRect.X, hScrollRect.Y, hScrollRect.Height, hScrollRect.Height)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("3", scrollFont, Brushes.White, thumbRect)
Dim sbi As New NativeMethods.SCROLLBARINFO()
sbi.cbSize = Marshal.SizeOf(sbi)
NativeMethods.GetScrollBarInfo(Me.Handle, NativeMethods.OBJID_HSCROLL, sbi)
thumbRect = Me.RectangleToScreen(Rectangle.FromLTRB(sbi.xyThumbTop, Me.ClientRectangle.Bottom + 1, sbi.xyThumbBottom, Me.ClientRectangle.Bottom + hScrollRect.Height + 1))
thumbRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Red, thumbRect)
thumbRect = New Rectangle(hScrollRect.Right - hScrollRect.Height, hScrollRect.Y, hScrollRect.Height, hScrollRect.Height)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("4", scrollFont, Brushes.White, thumbRect)
End If
If (Me.VScroll) Then
Dim vScrollRect As Rectangle = Me.RectangleToScreen(New Rectangle(Me.ClientSize.Width, 0, SystemInformation.VerticalScrollBarWidth, Me.ClientSize.Height))
vScrollRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Aqua, vScrollRect)
Dim thumbRect As Rectangle = New Rectangle(vScrollRect.X, vScrollRect.Y, vScrollRect.Width, vScrollRect.Width)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("5", scrollFont, Brushes.White, thumbRect)
Dim sbi As New NativeMethods.SCROLLBARINFO()
sbi.cbSize = Marshal.SizeOf(sbi)
NativeMethods.GetScrollBarInfo(Me.Handle, NativeMethods.OBJID_VSCROLL, sbi)
thumbRect = Me.RectangleToScreen(Rectangle.FromLTRB(Me.ClientRectangle.Right + 1, sbi.xyThumbTop, Me.ClientRectangle.Right + vScrollRect.Width + 1, sbi.xyThumbBottom))
thumbRect.Offset(-Me.Left, -Me.Top)
gr.FillRectangle(Brushes.Red, thumbRect)
thumbRect = New Rectangle(vScrollRect.X, vScrollRect.Bottom - vScrollRect.Width, vScrollRect.Width, vScrollRect.Width)
gr.FillRectangle(Brushes.Green, thumbRect)
gr.DrawString("6", scrollFont, Brushes.White, thumbRect)
End If
'Paint the Caption Buttons
Dim buttonSize As Size = SystemInformation.SmallCaptionButtonSize
buttonSize.Width -= 3
Dim buttonRect As Rectangle = New Rectangle(Me.Width - buttonSize.Width - 5, 5, buttonSize.Width, buttonSize.Height)
gr.FillEllipse(Brushes.Red, buttonRect)
buttonRect.Offset(-buttonRect.Width - 2, 0)
gr.FillEllipse(Brushes.Orange, buttonRect)
buttonRect.Offset(-buttonRect.Width - 2, 0)
gr.FillEllipse(Brushes.Yellow, buttonRect)
'Paint the Caption String
sf.Alignment = StringAlignment.Near
sf.Trimming = StringTrimming.EllipsisCharacter
gr.DrawString(Me.Text, SystemFonts.CaptionFont, Brushes.White, RectangleF.FromLTRB(3, buttonRect.Top, buttonRect.Left, buttonRect.Bottom), sf)
End Using
End Using
gr.ResetClip()
End If
End Using
'Use Interop to transfer the bitmap to the screen.
Dim screenDC As IntPtr = NativeMethods.GetDC(IntPtr.Zero)
Dim memDC As IntPtr = NativeMethods.CreateCompatibleDC(screenDC)
Dim hBitmap As IntPtr = backBuffer.GetHbitmap(Color.FromArgb(0))
Dim oldBitmap As IntPtr = NativeMethods.SelectObject(memDC, hBitmap)
Dim blend As New NativeMethods.BLENDFUNCTION(255)
Dim ptDst As Point = Me.Location
Dim szDst As Size = backBuffer.Size
Dim ptSrc As Point = Point.Empty
NativeMethods.UpdateLayeredWindow(Me.Handle, screenDC, ptDst, szDst, memDC, ptSrc, 0, blend, NativeMethods.ULW_ALPHA)
NativeMethods.SelectObject(memDC, oldBitmap)
NativeMethods.DeleteObject(hBitmap)
NativeMethods.DeleteDC(memDC)
NativeMethods.DeleteDC(screenDC)
End Using
End Sub
Private Function CreateFormShape() As GraphicsPath
Dim formShape As GraphicsPath = New GraphicsPath()
formShape.AddArc(0, 0, 12, 12, 180, 90)
formShape.AddArc(Me.Width - 13, 0, 12, 12, 270, 90)
formShape.AddLine(Me.Width - 1, 12, Me.Width - 1, Me.Height - 1)
formShape.AddLine(Me.Width - 1, Me.Height - 1, 0, Me.Height - 1)
formShape.CloseFigure()
Return formShape
End Function
End Class
Public Class NativeMethods
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function UpdateLayeredWindow(ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pptSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Boolean
End Function
<DllImport("uxtheme.dll")> _
Friend Shared Function SetWindowTheme(ByVal hwnd As IntPtr, ByVal pszSubAppName As String, ByVal pszSubIdList As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function CreateCompatibleDC(ByVal dc As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function SelectObject(ByVal hdc As IntPtr, ByVal hObj As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function DeleteDC(ByVal dc As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll")> _
Friend Shared Function DeleteObject(ByVal hObj As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Friend Shared Function GetScrollBarInfo(ByVal hwnd As IntPtr, ByVal idObject As Int32, ByRef psbi As SCROLLBARINFO) As Boolean
End Function
<StructLayout(LayoutKind.Sequential, Pack:=1)> _
Friend Structure BLENDFUNCTION
Public BlendOp, BlendFlags, SourceConstantAlpha, AlphaFormat As Byte
Public Sub New(ByVal alpha As Byte)
Me.BlendOp = AC_SRC_OVER
Me.BlendFlags = 0
Me.SourceConstantAlpha = alpha
Me.AlphaFormat = AC_SRC_ALPHA
End Sub
End Structure
<StructLayout(LayoutKind.Sequential)> _
Friend Structure SCROLLBARINFO
Public cbSize As Int32
Public rcScrollBar As RECT
Public dxyLineButton, xyThumbTop, xyThumbBottom, reserved As Int32
Public scrollbar, incbtn, pgup, thumb, pgdn, decbtn As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
Friend Structure RECT
Public Left, Top, Right, Bottom As Int32
End Structure
Friend Const AC_SRC_OVER As Int32 = &H0
Friend Const AC_SRC_ALPHA As Int32 = &H1
Friend Const ULW_ALPHA As Int32 = &H2
Friend Const WS_EX_LAYERED As Int32 = &H80000
Friend Const OBJID_HSCROLL As Int32 = &HFFFFFFFA '-6
Friend Const OBJID_VSCROLL As Int32 = &HFFFFFFFB '-5
End Class
This Program uses a Layered Window so that all drawing is done by you, including that of child controls. This type of window will never recieve or respond to a standard Paint message.
Advantages of this method include the ability to draw the Scrollbars in any style you wish as well as having the ability to change Alpha levels on a pixel by pixel basis. Just be aware that if you set alpha to zero, then the mouse events will fall through to the window below.
A disadvantage to this method is that not all child windows support DrawToBitmap() and so will not render themselves correctly with the simple UpdateWindow() method used here.
You will need to expand the code to paint the window differently depending upon window focus and mouse position, but adding non client mouse handling is beyond the scope of this simple example. You may call UpdateWindow() whenever the Form or one of it's child controls needs repainting.
DOWNLOAD PROJECT VB NET HERE!