Desain Custom Form Border dengan VB net
Lnguage: VB net (NetFramework 4.0) (bisa juga NetFramework 3.5 atau sebelumnya)
Untuk mendesain Forms dengan custom border program ini menggunakan dll:
berikut ini fungsi API yang digunakan:
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
DOWNLOAD PROJECT VB NET HERE!
by: Klampok_Child | Original Source Code by: http://dotnetrix.co.uk
Untuk mendesain Forms dengan custom border program ini menggunakan dll:
- user32.dll
- uxtheme.dll
- gdi32.dll
berikut ini fungsi API yang digunakan:
- 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
DOWNLOAD PROJECT VB NET HERE!
0 comments:
Posting Komentar