Posted 23 December 2009 - 01:36 PM
Intro:
Okay we all know about the shocking release that was included with Windows Vista - the Aero interface. With its Glass Window Borders and shiny Buttons, but I recently felt a strange desire to turn my entire form to glass, with interesting results.
This is the kind of thing that we will be creating:
(With my funky background
)Down To The Code
To do this we need to import some dll's, but we cannot do this the usual way with imports system.Windows.Forms.ETC, because we are calling a C function, one that is built into windows to do this we do something along the lines of:
<DllImport("DLL_To_Be_Imported")> Public Function FunctionFromDLLGettingImported (ByVal InputToFunction as Type) As Type
End Function
Now I bet your thinking, how do I import C sub's? Well... you dont, only functions if there is no result expected then there will usually be a return value of boolean, true for success false for failure. Or They can be integers same rule 1 = success, 0 = faliure.
So what API's are we going to need to import? Two both from dwmapi.dll. They are DwmIsCompositionEnabled - which we will use to check to see if the system supports the aero interface. And DwmExtendFrameIntoClientArea which does what it says, we will use this to extend the glass into the client area of the form (the place where you stick your buttons and labels). Here is the code for those API's :
<System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
Private Shared Function DwmIsCompositionEnabled(ByRef en As Integer) As Integer
End Function
<System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
Private Shared Function DwmExtendFrameIntoClientArea(ByVal hwnd As IntPtr, ByRef margin As MARGINS) As Integer
End Function
You may notice that requires a MARGINS object, it is a structure that we can use to tell this C function how far to extend the borders. This Structure is below:
Private Structure MARGINS Public m_Left As Integer Public m_Right As Integer Public m_Top As Integer Public m_Bottom As Integer End Structure
Now onto the usage.
Usage:
It is really quite simple to use this code all you have to do is to call the DwmExtendFrameIntoClientArea function with a margins object. But to prevent horrible exceptions and errors and your app from crashing we will use the following code.
Private Sub SetGlass(ByVal Form As Form, ByVal Type As SizeOfGlass)
Dim en As Integer = 0
Dim mg As New MARGINS()
If Type = SizeOfGlass.All Then
mg.m_Bottom = -1
mg.m_Left = -1
mg.m_Right = -1
mg.m_Top = -1
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
ElseIf Type = SizeOfGlass.Custom Then
mg.m_Bottom = Bottom
mg.m_Left = Left
mg.m_Right = Right
mg.m_Top = Top
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
End If
End Sub
Public Sub SetGlass(ByVal Form As Form, ByVal Auto As Boolean, Optional ByVal Top As Integer = 0, Optional ByVal Bottom As Integer = 0, Optional ByVal Left As Integer = 0, Optional ByVal Right As Integer = 0)
If Auto = True Then
SetGlass(Form, SizeOfGlass.All)
Else
Me.Top = Top
Me.Bottom = Bottom
Me.Left = Left
Me.Right = Right
SetGlass(Form, SizeOfGlass.Custom)
End If
End Sub
Private Enum SizeOfGlass
All = 1
Custom = 2
End Enum
Private Left As Integer = 0
Private Right As Integer = 0
Private Top As Integer = 0
Private Bottom As Integer = 0
I will explain this item by item, so to speak. All this code is designed to be used in a class rather than a form.
The Enum:
This code is to make it easier to use the code from a form so rather than creating a new margins object and chain passing it through sub to sub, we can just use this and create a Margins object later.
Private Enum SizeOfGlass All = 1 Custom = 2 End Enum
The Declarations:
This is merely to hold any integers until they are required, because I dislike chaining objects across a class.
Private Left As Integer = 0 Private Right As Integer = 0 Private Top As Integer = 0 Private Bottom As Integer = 0
The SetGlass Subs:
Basically to make this class easier to use from the outside (ie. from a form). Users Access the public SetGlass sub, that then changes the above declarations as neccacery then starts the Private SetGlass sub, which then creates a MARGINS object ready to be passed to the C function. Along the way it checks if the Aero interface is enabled, if it isnt throw an error, if it is continue.
Private Sub SetGlass(ByVal Form As Form, ByVal Type As SizeOfGlass)
Dim en As Integer = 0
Dim mg As New MARGINS()
If Type = SizeOfGlass.All Then
mg.m_Bottom = -1
mg.m_Left = -1
mg.m_Right = -1
mg.m_Top = -1
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the aero interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the aero theme capibility.")
End If
ElseIf Type = SizeOfGlass.Custom Then
mg.m_Bottom = Bottom
mg.m_Left = Left
mg.m_Right = Right
mg.m_Top = Top
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
End If
End Sub
Public Sub SetGlass(ByVal Form As Form, ByVal Auto As Boolean, Optional ByVal Top As Integer = 0, Optional ByVal Bottom As Integer = 0, Optional ByVal Left As Integer = 0, Optional ByVal Right As Integer = 0)
If Auto = True Then
SetGlass(Form, SizeOfGlass.All)
Else
Me.Top = Top
Me.Bottom = Bottom
Me.Left = Left
Me.Right = Right
SetGlass(Form, SizeOfGlass.Custom)
End If
End Sub
So the Complete code for this BASIC class to turn forms to glass?
Complete Code for turning forms to glass
:
''' <summary>
''' Creates A Glass Interface.
''' </summary>
''' <remarks></remarks>
Public Class Glass
<System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
Private Shared Function DwmIsCompositionEnabled(ByRef en As Integer) As Integer
End Function
<System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
Private Shared Function DwmExtendFrameIntoClientArea(ByVal hwnd As IntPtr, ByRef margin As MARGINS) As Integer
End Function
Private Left As Integer = 0
Private Right As Integer = 0
Private Top As Integer = 0
Private Bottom As Integer = 0
Private Sub SetGlass(ByVal Form As Form, ByVal Type As SizeOfGlass)
Dim en As Integer = 0
Dim mg As New MARGINS()
If Type = SizeOfGlass.All Then
mg.m_Bottom = -1
mg.m_Left = -1
mg.m_Right = -1
mg.m_Top = -1
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
ElseIf Type = SizeOfGlass.Custom Then
mg.m_Bottom = Bottom
mg.m_Left = Left
mg.m_Right = Right
mg.m_Top = Top
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
End If
End Sub
Private Enum SizeOfGlass
All = 1
Custom = 2
End Enum
Sub New(ByVal Form As Form, ByVal Auto As Boolean, Optional ByVal Top As Integer = 0, Optional ByVal Bottom As Integer = 0, Optional ByVal Left As Integer = 0, Optional ByVal Right As Integer = 0)
If Auto = True Then
SetGlass(Form, SizeOfGlass.All)
Else
Me.Top = Top
Me.Bottom = Bottom
Me.Left = Left
Me.Right = Right
SetGlass(Form, SizeOfGlass.Custom)
End If
End Sub
Sub New()
End Sub
Public Sub SetGlass(ByVal Form As Form, ByVal Auto As Boolean, Optional ByVal Top As Integer = 0, Optional ByVal Bottom As Integer = 0, Optional ByVal Left As Integer = 0, Optional ByVal Right As Integer = 0)
If Auto = True Then
SetGlass(Form, SizeOfGlass.All)
Else
Me.Top = Top
Me.Bottom = Bottom
Me.Left = Left
Me.Right = Right
SetGlass(Form, SizeOfGlass.Custom)
End If
End Sub
Private Structure MARGINS
Public m_Left As Integer
Public m_Right As Integer
Public m_Top As Integer
Public m_Bottom As Integer
End Structure
End Class
In the next 'chapter' I will mention some of the issues of this.
Issues of this:
Well see for yourself:
Issue 1. No Glass
Easily solved you need to change your forms background to black. Or change the background colour to some colour you are never going to use, then set your forms transparency key to that colour (a little buggy).
Second Issue:
it looked like this at design time:
My form looks rubbish!!! Well you shouldnt have any black on your form or it will turn to glass (*Ghostly Noises*
).My rough solution to this was to create a component of my own which I will demonstrate to you below, it is a label that at design time acts like a label, but at runtime hides itself and uses GDI+ to draw its text representive as an image onto your form. But First...
An Advanced version of the above Class
Well advanced maybe but it offers more functionality, I could write this in but its not my code, (it from the code project converted from C#, painfully...), anyway that class is below, it follows the same principles but has some more functionality.
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Friend Class Glass_Full
Private Const DTT_COMPOSITED As Integer = CInt((1 << 13))
Private Const DTT_GLOWSIZE As Integer = CInt((1 << 11))
'Text format consts
Private Const DT_SINGLELINE As Integer = &H20
Private Const DT_CENTER As Integer = &H1
Private Const DT_VCENTER As Integer = &H4
Private Const DT_NOPREFIX As Integer = &H800
'Const for BitBlt
Private Const SRCCOPY As Integer = &HCC0020
'Consts for CreateDIBSection
Private Const BI_RGB As Integer = 0
Private Const DIB_RGB_COLORS As Integer = 0
'color table in RGBs
Private Structure MARGINS
Public m_Left As Integer
Public m_Right As Integer
Public m_Top As Integer
Public m_Buttom As Integer
End Structure
Private Structure POINTAPI
Public x As Integer
Public y As Integer
End Structure
Private Structure DTTOPTS
Public dwSize As UInteger
Public dwFlags As UInteger
Public crText As UInteger
Public crBorder As UInteger
Public crShadow As UInteger
Public iTextShadowType As Integer
Public ptShadowOffset As POINTAPI
Public iBorderSize As Integer
Public iFontPropId As Integer
Public iColorPropId As Integer
Public iStateId As Integer
Public fApplyOverlay As Integer
Public iGlowSize As Integer
Public pfnDrawTextCallback As IntPtr
Public lParam As Integer
End Structure
Private Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Private Structure BITMAPINFOHEADER
Public biSize As Integer
Public biWidth As Integer
Public biHeight As Integer
Public biPlanes As Short
Public biBitCount As Short
Public biCompression As Integer
Public biSizeImage As Integer
Public biXPelsPerMeter As Integer
Public biYPelsPerMeter As Integer
Public biClrUsed As Integer
Public biClrImportant As Integer
End Structure
Private Structure RGBQUAD
Public rgbBlue As Byte
Public rgbGreen As Byte
Public rgbRed As Byte
Public rgbReserved As Byte
End Structure
Private Structure BITMAPINFO
Public bmiHeader As BITMAPINFOHEADER
Public bmiColors As RGBQUAD
End Structure
'API declares
<DllImport("dwmapi.dll")> _
Private Shared Sub DwmIsCompositionEnabled(ByRef enabledptr As Integer)
End Sub
<DllImport("dwmapi.dll")> _
Private Shared Sub DwmExtendFrameIntoClientArea(ByVal hWnd As IntPtr, ByRef margin As MARGINS)
End Sub
Private Declare Auto Function GetDC Lib "user32.dll" (ByVal hdc As IntPtr) As IntPtr
Private Declare Auto Function SaveDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Integer
Private Declare Auto Function ReleaseDC Lib "user32.dll" (ByVal hdc As IntPtr, ByVal state As Integer) As Integer
Private Declare Auto Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As IntPtr) As IntPtr
<DllImport("gdi32.dll", ExactSpelling:=True)> _
Private Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
End Function
Private Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean
Private Declare Auto Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Boolean
<DllImport("gdi32.dll")> _
Private Shared Function BitBlt(ByVal hdc As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, _
ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As UInteger) As Boolean
End Function
Private Declare Unicode Function DrawThemeTextEx Lib "UxTheme.dll" (ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, _
ByVal dwFlags As Integer, ByRef pRect As RECT, ByRef pOptions As DTTOPTS) As Integer
Private Declare Auto Function DrawThemeText Lib "UxTheme.dll" (ByVal hTheme As IntPtr, ByVal hdc As IntPtr, ByVal iPartId As Integer, ByVal iStateId As Integer, ByVal text As String, ByVal iCharCount As Integer, _
ByVal dwFlags1 As Integer, ByVal dwFlags2 As Integer, ByRef pRect As RECT) As Integer
Private Declare Auto Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As IntPtr, ByRef pbmi As BITMAPINFO, ByVal iUsage As UInteger, ByVal ppvBits As Integer, ByVal hSection As IntPtr, ByVal dwOffset As UInteger) As IntPtr
Public Sub SetGlass(ByVal Form As Form)
Dim en As Integer = 0
Dim mg As New MARGINS()
mg.m_Buttom = -1
mg.m_Left = -1
mg.m_Right = -1
mg.m_Top = -1
'make sure you are not on a legacy OS
If System.Environment.OSVersion.Version.Major >= 6 Then
DwmIsCompositionEnabled(en)
'check if the desktop composition is enabled
If en > 0 Then
DwmExtendFrameIntoClientArea(Form.Handle, mg)
Else
Throw New ApplicationException("This computer does not have the areo interface enabled.")
End If
Else
Throw New ApplicationException("This computer does not have the areo theme capibility.")
End If
End Sub
Private Function IsCompositionEnabled() As Boolean
If Environment.OSVersion.Version.Major < 6 Then
Return False
End If
Dim compositionEnabled As Integer = 0
DwmIsCompositionEnabled(compositionEnabled)
If compositionEnabled > 0 Then
Return True
Else
Return False
End If
End Function
Public Sub FillBlackRegion(ByVal gph As Graphics, ByVal rgn As Rectangle)
Dim rc As New RECT()
rc.left = rgn.Left
rc.right = rgn.Right
rc.top = rgn.Top
rc.bottom = rgn.Bottom
Dim destdc As IntPtr = gph.GetHdc()
'hwnd must be the handle of form,not control
Dim Memdc As IntPtr = CreateCompatibleDC(destdc)
Dim bitmap As IntPtr
Dim bitmapOld As IntPtr = IntPtr.Zero
Dim dib As New BITMAPINFO()
dib.bmiHeader.biHeight = -(rc.bottom - rc.top)
dib.bmiHeader.biWidth = rc.right - rc.left
dib.bmiHeader.biPlanes = 1
dib.bmiHeader.biSize = Marshal.SizeOf(GetType(BITMAPINFOHEADER))
dib.bmiHeader.biBitCount = 32
dib.bmiHeader.biCompression = BI_RGB
If Not (SaveDC(Memdc) = 0) Then
bitmap = CreateDIBSection(Memdc, dib, DIB_RGB_COLORS, 0, IntPtr.Zero, 0)
If Not (bitmap = IntPtr.Zero) Then
bitmapOld = SelectObject(Memdc, bitmap)
BitBlt(destdc, rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top, Memdc, _
0, 0, SRCCOPY)
End If
'Remember to clean up
SelectObject(Memdc, bitmapOld)
DeleteObject(bitmap)
ReleaseDC(Memdc, -1)
DeleteDC(Memdc)
End If
gph.ReleaseHdc()
End Sub
Public Sub DrawTextOnGlass(ByVal hwnd As IntPtr, ByVal text As [String], ByVal font As Font, ByVal ctlrct As Rectangle, ByVal iglowSize As Integer)
If IsCompositionEnabled() Then
Dim rc As New RECT()
Dim rc2 As New RECT()
rc.left = ctlrct.Left
rc.right = ctlrct.Right + 2 * iglowSize
'make it larger to contain the glow effect
rc.top = ctlrct.Top
rc.bottom = ctlrct.Bottom + 2 * iglowSize
'Just the same rect with rc,but (0,0) at the lefttop
rc2.left = 0
rc2.top = 0
rc2.right = rc.right - rc.left
rc2.bottom = rc.bottom - rc.top
Dim destdc As IntPtr = GetDC(hwnd)
'hwnd must be the handle of form,not control
Dim Memdc As IntPtr = CreateCompatibleDC(destdc)
' Set up a memory DC where we'll draw the text.
Dim bitmap As IntPtr
Dim bitmapOld As IntPtr = IntPtr.Zero
Dim logfnotOld As IntPtr
Dim uFormat As Integer = DT_SINGLELINE Or DT_CENTER Or DT_VCENTER Or DT_NOPREFIX
'text format
Dim dib As New BITMAPINFO()
dib.bmiHeader.biHeight = -(rc.bottom - rc.top)
' negative because DrawThemeTextEx() uses a top-down DIB
dib.bmiHeader.biWidth = rc.right - rc.left
dib.bmiHeader.biPlanes = 1
dib.bmiHeader.biSize = Marshal.SizeOf(GetType(BITMAPINFOHEADER))
dib.bmiHeader.biBitCount = 32
dib.bmiHeader.biCompression = BI_RGB
If Not (SaveDC(Memdc) = 0) Then
bitmap = CreateDIBSection(Memdc, dib, DIB_RGB_COLORS, 0, IntPtr.Zero, 0)
' Create a 32-bit bmp for use in offscreen drawing when glass is on
If Not (bitmap = IntPtr.Zero) Then
bitmapOld = SelectObject(Memdc, bitmap)
Dim hFont As IntPtr = font.ToHfont()
logfnotOld = SelectObject(Memdc, hFont)
Try
Dim renderer As New System.Windows.Forms.VisualStyles.VisualStyleRenderer(System.Windows.Forms.VisualStyles.VisualStyleElement.window.Caption.Active)
Dim dttOpts As New DTTOPTS()
dttOpts.dwSize = CUInt(Marshal.SizeOf(GetType(DTTOPTS)))
dttOpts.dwFlags = DTT_COMPOSITED Or DTT_GLOWSIZE
dttOpts.iGlowSize = iglowSize
DrawThemeTextEx(renderer.Handle, Memdc, 0, 0, text, -1, _
uFormat, rc2, dttOpts)
BitBlt(destdc, rc.left, rc.top, rc.right - rc.left, rc.bottom - rc.top, Memdc, _
0, 0, SRCCOPY)
Catch e As Exception
Trace.WriteLine(e.Message)
End Try
'Remember to clean up
SelectObject(Memdc, bitmapOld)
SelectObject(Memdc, logfnotOld)
DeleteObject(bitmap)
DeleteObject(hFont)
ReleaseDC(Memdc, -1)
DeleteDC(Memdc)
End If
End If
End If
End Sub
End Class
Im not going to explain this because that would be more of a GDI+ tutorial than a API / Windows Glass tutorial. So to give you an example of how to use this code I wrote this label control:
Public Class MegaLabel Inherits Label Dim Glass As New Glass_Full Dim Panel As New Rectangle Dim _Font As Font Dim _FontSize As Integer Dim _Text As String Private Sub DrawText() Glass.DrawTextOnGlass(Me.Parent.Handle, _Text, _Font, Panel, _FontSize) Me.Visible = False End Sub Private Sub MegaLabel_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint If DesignMode = False Then Me.Visible = True _Font = Me.Font _FontSize = Me.Font.Size _Text = Me.Text Me.Visible = False Panel.Size = New Size(Me.Size.Width, Me.Size.Height) Panel.Location = New Point(Me.Location.X, Me.Location.Y) DrawText() End If End Sub End Class
Basically what it does is creates a Rectangle object then moves it around to labels location then when it is runtime the label is hidden and the text is written to the form in exactly the same style. Using it I can do this:
Which solves the problem, if you were to delve into the Glass_Full class you would find functionality to do the same with an image, you would have to write a new component that inherits picture box... ETC. But byfar the best solution is to not turn your entire form to glass, its a shame but who wants a glass form anyway?
Other Notes:
There are ways that you can send user controls that have some panels on them behind a glass form to create the glass effect of the colours behind them. But that involves some trickery, and slightly messy code so I wont post it here but I am sure that if you examine the above code you can find the solution easily. Also there are a few bugs with my label a few being;
1.) Alt clears the drawn on text - No idea why, probably due to the system forcing a refresh on the window.
2.) if you change the size of the form hiding the label, then grow the form again the label isnt there, you just need to refresh the label so the Onpaint sub is raised again, to repaint the text onto the window.
Anyway Enjoy now you can create glass forms
, though remember its not always worth it.
MultiQuote
| 