S
H
A
R
E

Friday, June 24, 2011

Custom Windows Form Border With Background Opacity

Lnguage: VB net (NetFramework 4.0) (will work in NetFramework 3.5 or before)
Custom Form Border With Background Opacity using VB net Csharp in Visual Studio with Windows API dll

Custom Border Resizable windows scroll bar enabled VB net Csharp in Visual Studio with Windows API dll.jpg


Transparent Form Background With Opacity using VB net Csharp in Visual Studio with Windows API dll


To make Forms with Custom Appearance, but standard Behaviour This program use the following dll:
  • user32.dll
  • uxtheme.dll
  • gdi32.dll
The following dll is on the Windows System by default, you don't need to download the dll again, exept your system is missing the files.
With Windows API in the dll, Program will use the following method/function:
  • CreateCompatibleDC
  • UpdateLayeredWindow
  • DeleteDC
  • DeleteObject
  • GetDC
  • GetScrollBarInfo
  • SelectObject
  • SetWindowTheme
This The Code Of The Sample Program:

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

27 comments:

Wadey said...

Awesome, just what I was after to get me started with this kind of thing!

Klampok Child said...

Thanks....

Anonymous said...

I am curious to find out what blog system you are utilizing?
I'm having some minor security issues with my latest blog and I'd
like to find something more secure. Do you have any solutions?



Here is my web site ... romantic vacation
Here is my homepage :: food business Ideas

Anonymous said...

Hello mates, pleasant article and pleasant urging commented here, I am really enjoying by these.
Here is my blog post - Home loan refinance bad credit

Anonymous said...

Write more, thats all I have to say. Literally, it seems as though you relied
on the video to make your point. You obviously know what
youre talking about, why waste your intelligence on just posting
videos to your blog when you could be giving us something informative to read?
My web site - all inclusive vacations virgin islands

Anonymous said...

I enjoy what you guys are up too. This sort of clever work and exposure!
Keep up the fantastic works guys I've added you guys to our blogroll.
Feel free to surf my web page : web hosting software

Anonymous said...

It's hard to find well-informed people for this subject, however, you seem like you know what you're talking
about! Thanks
Also visit my homepage : Michigan Seo expert

Anonymous said...

Hi there i am kavin, its my first time to commenting anyplace, when i read this piece
of writing i thought i could also make comment due to this brilliant post.
Also see my website - Refinance Student Loans

Anonymous said...

Howdy very cool blog!! Guy .. Excellent .. Wonderful ..
I will bookmark your blog and take the feeds also?

I'm glad to seek out so many useful info here within the put up, we want develop extra strategies in this regard, thanks for sharing. . . . . .
Here is my web blog - highest paying affiliate programs

Anonymous said...

It's fantastic that you are getting thoughts from this piece of writing as well as from our discussion made at this time.
Feel free to surf my weblog ; home equity loan of credit

Anonymous said...

Hi there! I could have sworn I've visited this web site before but after browsing through many of the articles I realized it's new to me.

Regardless, I'm definitely pleased I discovered it and I'll be bookmarking
it and checking back often!
My website - privat krankenversicherungen vergleich

Anonymous said...

Hey There. I found your weblog the use of
msn. That is a really well written article. I will make sure to bookmark it and come back to learn extra
of your useful information. Thanks for the post.
I will certainly return.
Look at my blog post :: schweizer kredit ohne schufa

Anonymous said...

Having read this I thought it was extremely informative.
I appreciate you finding the time and effort to put this information together.
I once again find myself spending a significant amount
of time both reading and posting comments. But so what,
it was still worthwhile!
Here is my weblog fenwick island vacation rentals

Anonymous said...

Awesome article.
Look at my blog ... free clickbank software

Anonymous said...

It's an awesome piece of writing designed for all the web viewers; they will get benefit from it I am sure.

my blog post: informationen Zur privaten krankenversicherung

Anonymous said...

I think the admin of this web site is really working hard in support of his website, for the reason that here every material
is quality based stuff.

my web page; best windows reseller hosting
Also see my page > how to resell hosting

Anonymous said...

I all the time used to study post in news
papers but now as I am a user of net thus from now I am using net for posts, thanks to
web.

Here is my homepage: Pkv vergleich anonym

Anonymous said...

Hi! Do you use Twitter? I'd like to follow you if that would be okay. I'm undoubtedly enjoying your blog and look forward to new updates.



Also visit my website ... Read the Full Piece of writing
my site :: seo services in uk

Anonymous said...

Today, while I was at work, my sister stole my apple ipad and tested to see if it can
survive a 25 foot drop, just so she can be a youtube sensation.

My iPad is now broken and she has 83 views. I know this is entirely off topic but I
had to share it with someone!

Check out my webpage; alle privaten krankenversicherungen

Anonymous said...

Wonderful, what a blog it is! This webpage gives useful information to us, keep it up.


My blog post ... click through the following website page

Anonymous said...

I am sure this piece of writing has touched all the internet visitors,
its really really good piece of writing on building up new blog.


Here is my blog; small business manufacturing software

Anonymous said...

Eхcellent, what a web site it is! This blog preѕents uѕeful facts to us, keeρ
іt up.

my blog post :: fast cash advance loan

Anonymous said...

Hi evеryone, it's my first visit at this web site, and content is actually fruitful designed for me, keep up posting such articles.

Also visit my site http://www.wwtl.fm/modules.php?name=Your_Account&op=userinfo&username=NathanVvc

Anonymous said...

Нello, Neat pοѕt. Therе is a prοblem ωith youг
web ѕite in internet exρlorer,
wоulԁ checκ thіѕ? IЕ ѕtill is the market chіеf аnԁ a
hugе ρoгtiοn of other pеople will omit
yοuг gгеat writing duе to thіs problem.



my wеb-sіte: best rate loan

Anonymous said...

Thiѕ infο is invаluable. Hoω саn I
find out more?

Feel freе to surf to mу blog - best loans uk

Anonymous said...

Heya i'm for the primary time here. I found this board and I find It truly useful & it helped me out much. I am hoping to offer one thing again and aid others such as you aided me.

Here is my website great loans site

Anonymous said...

Spot on with this write-up, I actually believе thіs amazing site needѕ а great
deal moгe attentіon. I'll probably be returning to see more, thanks for the info!

Feel free to visit my site: fast cash loans with no credit check

Post a Comment