Alpha-Blended Forms revisited | BASeCamp Programming Blog

Previously I wrote about implementing a Alpha-blended form with VB.NET. In that implementation, I had an abstract class derive from Form and then the actual forms derive from that. This causes issues with using the Form in the designer.

In order to workaround that issue I’ve redone parts of the implementation a bit to get it working as it’s own separate class. Rather than rely on the CreateParams() to adjust the GWL_EXSTYLE when the form is initially created, it merely uses SetWindowLong() to change it at runtime. Otherwise, the core of what it does is largely the same- just refactored into a package that doesn’t break the designer.

It should be noted, however, that adding controls to the form will not function as intended, though- this is inherent in the Alpha Blending feature, as it effectively just draws the bitmap. This is why it works well for Splash Screens. Controls will still respond to events and clicks however they will be invisible; making them visible would require drawing them onto the Bitmap and then setting it as the new Layered Window bitmap each time controls change.

Here is the changed code:

Imports System
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Windows.Forms
Imports System.Runtime.InteropServices


' class that exposes needed windows GDI Functions.
Public Class Win32
    Public Enum Bool
        bFalse = 0
        bTrue = 1
    End Enum


     <StructLayout(LayoutKind.Sequential)>
    Public 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
    End Structure


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

        Public Sub New(cx As Int32, 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


     <DllImport("user32.dll", ExactSpelling := True, SetLastError := True)>
    Public Shared Function UpdateLayeredWindow(hwnd As IntPtr, hdcDst As IntPtr, ByRef pptDst As Point,
                                               ByRef psize As Size, hdcSrc As IntPtr, ByRef pprSrc As Point,
                                               crKey As Int32, ByRef pblend As BLENDFUNCTION, dwFlags As Int32) As Bool
    End Function

     <DllImport("user32.dll", ExactSpelling := True, SetLastError := True)>
    Public Shared Function GetDC(hWnd As IntPtr) As IntPtr
    End Function

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

     <DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>
    Public Shared Function CreateCompatibleDC(hDC As IntPtr) As IntPtr
    End Function

     <DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>
    Public Shared Function DeleteDC(hdc As IntPtr) As Bool
    End Function

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

     <DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>
    Public Shared Function DeleteObject(hObject As IntPtr) As Bool
    End Function

     <DllImport("user32.dll", SetLastError := true, CharSet := CharSet.Auto)>
    Public Shared Function GetWindowLong(ByVal hWnd As Int32, ByVal nIndex As Int32) As Int32
    End Function

     <DllImport("user32.dll", SetLastError := true, CharSet := CharSet.Auto)>
    Public Shared Function SetWindowLong(ByVal hwnd As Int32, ByVal nIndex As Int32, ByVal dwNewLong As Int32) As Int32
    End Function

    Public Const GWL_EXSTYLE As Int32 = - 20
    Public Const WS_EX_LAYERED As Int32 = &H80000
End Class

Public Class AlphaFormHelper
    Private _ManageForm As Form
    Private _AlphaImage As Image

    Public Sub New(pUseForm As Form, pAlphaImage As Image, Optional Opacity As Byte = 255)
        _ManageForm = pUseForm
        _ManageForm.FormBorderStyle = FormBorderStyle.None
        _AlphaImage = pAlphaImage
        PrepareForm(_ManageForm)
        SetBitmap(_AlphaImage, Opacity)
    End Sub

    Private Sub PrepareForm(pForm As Form)

        Dim CurrentFlags As Integer = Win32.GetWindowLong(pForm.Handle, Win32.GWL_EXSTYLE)
        CurrentFlags = CurrentFlags Or Win32.WS_EX_LAYERED

        Win32.SetWindowLong(pForm.Handle, Win32.GWL_EXSTYLE, CurrentFlags)
    End Sub


    public Overloads Sub SetBitmap(bmp As Image)
        Dim buildbitmap As Bitmap = new Bitmap(bmp)
        SetBitmap(buildbitmap)
    End Sub

    Public Overloads Sub SetBitmap(bmp As Image, Opacity As Byte)
        Dim buildbitmap As Bitmap = New Bitmap(bmp)
        SetBitmap(buildbitmap, Opacity)
    End Sub

    Public Overloads Sub SetBitmap(bmp As Bitmap)
        SetBitmap(bmp, 255)
    End Sub

    Public Overloads Sub SetBitmap(bmp As Bitmap, Opacity As Byte)

        If bmp.PixelFormat  <> PixelFormat.Format32bppArgb Then
            Throw New ApplicationException("The Bitmap must be a 32bpp with a Alpha Channel")
        End If

        'Create Compatible DC with the screem
        'Select bitmap with 32bpp with alpha into the compatible DC
        'call UpdateLayeredWindow

        Dim ScreenDC As IntPtr = Win32.GetDC(IntPtr.Zero)
        Dim MemDC As IntPtr = Win32.CreateCompatibleDC(ScreenDC)
        Dim hBitmap As IntPtr = IntPtr.Zero
        Dim oldBitmap As IntPtr = IntPtr.Zero
        Try
            hBitmap = bmp.GetHbitmap(Color.FromArgb(0))
            oldBitmap = Win32.SelectObject(MemDC, hBitmap)
            Dim thesize As Win32.Size = New Win32.Size(bmp.Width, bmp.Height)
            Dim pointSource As Win32.Point = New Win32.Point(0, 0)
            Dim topPos As Win32.Point = New Win32.Point(_ManageForm.Left, _ManageForm.Top)
            Dim blend As Win32.BLENDFUNCTION = New Win32.BLENDFUNCTION()
            blend.BlendOp = Win32.AC_SRC_OVER
            blend.BlendFlags = 0
            blend.SourceConstantAlpha = Opacity
            blend.AlphaFormat = Win32.AC_SRC_ALPHA
            Win32.UpdateLayeredWindow(_ManageForm.Handle, ScreenDC, topPos,
                                      New Win32.Size(_ManageForm.Size.Width, _ManageForm.Size.Height), MemDC,
                                      pointSource, 0, blend, Win32.ULW_ALPHA)

        Catch ex As Exception

        Finally
            Win32.ReleaseDC(IntPtr.Zero, ScreenDC)
            If Not hBitmap = IntPtr.Zero Then
                Win32.SelectObject(MemDC, oldBitmap)
                Win32.DeleteObject(hBitmap)
            End If
            Win32.DeleteDC(MemDC)

        End Try
    End Sub
End Class

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

Imports System

Imports System.Drawing

Imports System.Drawing.Imaging

Imports System.Windows.Forms

Imports System.Runtime.InteropServices

' class that exposes needed windows GDI Functions.

Public Class Win32

Public Enum Bool

bFalse = 0

bTrue = 1

End Enum

<StructLayout(LayoutKind.Sequential)>

Public 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

End Structure

<StructLayout(LayoutKind.Sequential)>

Public Structure Size

Public cx As Int32

Public cy As Int32

Public Sub New(cx As Int32, 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

<DllImport("user32.dll", ExactSpelling := True, SetLastError := True)>

Public Shared Function UpdateLayeredWindow(hwnd As IntPtr, hdcDst As IntPtr, ByRef pptDst As Point,

ByRef psize As Size, hdcSrc As IntPtr, ByRef pprSrc As Point,

crKey As Int32, ByRef pblend As BLENDFUNCTION, dwFlags As Int32) As Bool

End Function

<DllImport("user32.dll", ExactSpelling := True, SetLastError := True)>

Public Shared Function GetDC(hWnd As IntPtr) As IntPtr

End Function

<DllImport("user32.dll", ExactSpelling := True)>

Public Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer

End Function

<DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>

Public Shared Function CreateCompatibleDC(hDC As IntPtr) As IntPtr

End Function

<DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>

Public Shared Function DeleteDC(hdc As IntPtr) As Bool

End Function

<DllImport("gdi32.dll", ExactSpelling := True)>

Public Shared Function SelectObject(hDC As IntPtr, hObject As IntPtr) As IntPtr

End Function

<DllImport("gdi32.dll", ExactSpelling := True, SetLastError := True)>

Public Shared Function DeleteObject(hObject As IntPtr) As Bool

End Function

<DllImport("user32.dll", SetLastError := true, CharSet := CharSet.Auto)>

Public Shared Function GetWindowLong(ByVal hWnd As Int32, ByVal nIndex As Int32) As Int32

End Function

<DllImport("user32.dll", SetLastError := true, CharSet := CharSet.Auto)>

Public Shared Function SetWindowLong(ByVal hwnd As Int32, ByVal nIndex As Int32, ByVal dwNewLong As Int32) As Int32

End Function

Public Const GWL_EXSTYLE As Int32 = - 20

Public Const WS_EX_LAYERED As Int32 = &H80000

End Class

Public Class AlphaFormHelper

Private _ManageForm As Form

Private _AlphaImage As Image

Public Sub New(pUseForm As Form, pAlphaImage As Image, Optional Opacity As Byte = 255)

_ManageForm = pUseForm

_ManageForm.FormBorderStyle = FormBorderStyle.None

_AlphaImage = pAlphaImage

PrepareForm(_ManageForm)

SetBitmap(_AlphaImage, Opacity)

End Sub

Private Sub PrepareForm(pForm As Form)

Dim CurrentFlags As Integer = Win32.GetWindowLong(pForm.Handle, Win32.GWL_EXSTYLE)

CurrentFlags = CurrentFlags Or Win32.WS_EX_LAYERED

Win32.SetWindowLong(pForm.Handle, Win32.GWL_EXSTYLE, CurrentFlags)

End Sub

public Overloads Sub SetBitmap(bmp As Image)

Dim buildbitmap As Bitmap = new Bitmap(bmp)

SetBitmap(buildbitmap)

End Sub

Public Overloads Sub SetBitmap(bmp As Image, Opacity As Byte)

Dim buildbitmap As Bitmap = New Bitmap(bmp)

SetBitmap(buildbitmap, Opacity)

End Sub

Public Overloads Sub SetBitmap(bmp As Bitmap)

SetBitmap(bmp, 255)

End Sub

Public Overloads Sub SetBitmap(bmp As Bitmap, Opacity As Byte)

If bmp.PixelFormat <> PixelFormat.Format32bppArgb Then

Throw New ApplicationException("The Bitmap must be a 32bpp with a Alpha Channel")

End If

'Create Compatible DC with the screem

'Select bitmap with 32bpp with alpha into the compatible DC

'call UpdateLayeredWindow

Dim ScreenDC As IntPtr = Win32.GetDC(IntPtr.Zero)

Dim MemDC As IntPtr = Win32.CreateCompatibleDC(ScreenDC)

Dim hBitmap As IntPtr = IntPtr.Zero

Dim oldBitmap As IntPtr = IntPtr.Zero

Try

hBitmap = bmp.GetHbitmap(Color.FromArgb(0))

oldBitmap = Win32.SelectObject(MemDC, hBitmap)

Dim thesize As Win32.Size = New Win32.Size(bmp.Width, bmp.Height)

Dim pointSource As Win32.Point = New Win32.Point(0, 0)

Dim topPos As Win32.Point = New Win32.Point(_ManageForm.Left, _ManageForm.Top)

Dim blend As Win32.BLENDFUNCTION = New Win32.BLENDFUNCTION()

blend.BlendOp = Win32.AC_SRC_OVER

blend.BlendFlags = 0

blend.SourceConstantAlpha = Opacity

blend.AlphaFormat = Win32.AC_SRC_ALPHA

Win32.UpdateLayeredWindow(_ManageForm.Handle, ScreenDC, topPos,

New Win32.Size(_ManageForm.Size.Width, _ManageForm.Size.Height), MemDC,

pointSource, 0, blend, Win32.ULW_ALPHA)

Catch ex As Exception

Finally

Win32.ReleaseDC(IntPtr.Zero, ScreenDC)

If Not hBitmap = IntPtr.Zero Then

Win32.SelectObject(MemDC, oldBitmap)

Win32.DeleteObject(hBitmap)

End If

Win32.DeleteDC(MemDC)

End Try

End Sub

End Class

In usage it is no more complex than before, really:

Public Class SplashForm
    Inherits Form
    Private useBackground As Bitmap
    Private PixelHelper As AlphaFormHelper
    Private Sub SplashForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        useBackground = My.Resources.splashAlpha
        Size = useBackground.Size
        PixelHelper = new AlphaFormHelper(Me,useBackground)
    End Sub
    
End Class

Public Class SplashForm

Inherits Form

Private useBackground As Bitmap

Private PixelHelper As AlphaFormHelper

Private Sub SplashForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load

useBackground = My.Resources.splashAlpha

Size = useBackground.Size

PixelHelper = new AlphaFormHelper(Me,useBackground)

End Sub

End Class

The end result is largely the same:

Have something to say about this post? Comment!

Tags: Alpha, Blending, Form, Per Pixel