Related
I'm looking to create a custom treeview control in VB.net, what I need to do is have a standard treeview control displaying the system file strucure for example, but with an extra icon on the right on the folder/file name that only appears on hover over of the node. So, for instance, if I hover over the folder Sup2 as shown in the pic, then the orange icon appears
I've done some research and from what I can see, I have to override the onpaint event to make this happen but I'm not sure exactly how to do this. I also need to add an onclick event to that new orange icon.
This is not professional but is worth giving a try..
I created a class that inherited from a Treeview control and overrode the constructor - changing the default width and height, setting the DrawMode to TreeViewDrawMode.OwnerDrawText.
Next, I handled the TreeView.DrawNode event, using a PictureBox to display the Image and changing its location based on the currently highlighted item.
I also handled the Click event of the PictureBox.Under that event, You can do whatever you want with the highlighted node.
I used images from My.Resources for ImageList.Images(0) and PictureBox.Image
Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim trv As New MyTreeView
trv.Nodes.Add("Suppliers")
trv.Nodes(0).Nodes.Add("Sup 1")
trv.Nodes(0).Nodes.Add("Sup 2")
trv.Nodes(0).Nodes.Add("Sup 3")
trv.Nodes(0).Nodes.Add("Sup 4")
trv.Nodes(0).Nodes.Add("Sup 5")
Controls.Add(trv)
End Sub
End Class
'Class Starts Here
Public Class MyTreeView
Inherits TreeView
WithEvents myImage As PictureBox
Dim activeItem As TreeNode 'Variable to store active TreeNode
Public Sub New()
MyBase.New() 'Call the base class constructor
'And set some values
Height = 300
Width = 300
Location = New Point(50, 50)
DrawMode = TreeViewDrawMode.OwnerDrawText 'Very neccesary
AddHandler DrawNode, AddressOf MyTreeViewDrawNode
'Add event handlers
AddHandler AfterCollapse, AddressOf MyTreeViewCollapsed
'Set HotTracking event to true to allow for MouseHover
HotTracking = True
ImageList = new ImageList
ImageList.Images.Add(My.Resources.FolderImage)
ImageIndex = 0
Font = New Font(Font.FontFamily, 10)
'Initialize picturebox
myImage = New PictureBox() With
{
.Image = My.Resources.editPencilImage,
.SizeMode = PictureBoxSizeMode.Zoom,
.Size = New Size(10, 10),
.Visible = False
}
Controls.Add(myImage)
End Sub
Private Sub MyTreeViewCollapsed(sender As Object, e As TreeViewEventArgs)
myImage.Visible = False
End Sub
Sub ImageClicked(sender As Object, e As EventArgs) Handles myImage.Click
If (Not activeItem Is Nothing) Then
MessageBox.Show("Clicked Item - " & activeItem.Text)
End If
End Sub
Private Sub MyTreeViewDrawNode(sender As Object, e As DrawTreeNodeEventArgs)
e.DrawDefault = True
If (e.State = TreeNodeStates.Hot) Then
myImage.Visible = True
activeItem = e.Node
Dim tmpSize = TextRenderer.MeasureText(e.Node.Text, Font)
myImage.Location = New Point(e.Node.Bounds.Location.X + tmpSize.Width, e.Node.Bounds.Location.Y)
End If
End Sub
End Class
I think the following example will give you some hints and tips.
Option Explicit On
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Text
Imports System.Runtime.InteropServices
Public Class TreeViewEx
Inherits TreeView
#Region "API"
Private Const TVM_SETEXTENDEDSTYLE As Integer = &H1100 + 44
Private Const TVS_EX_DOUBLEBUFFER As Integer = &H4
<DllImport("user32.dll")>
Private Shared Function SendMessage(ByVal hWnd As IntPtr,
ByVal msg As Integer,
ByVal wp As IntPtr,
ByVal lp As IntPtr) As IntPtr
End Function
#End Region
#Region "Private Fields"
Private ReadOnly RightImage As Bitmap
Private ReadOnly NSF As StringFormat
Private HoverNode As TreeNode
Private RightImageRect As Rectangle
#End Region
#Region "Constructors"
Sub New()
DrawMode = TreeViewDrawMode.OwnerDrawText
RightImage = New Bitmap(My.Resources.Modify)
NSF = New StringFormat With {
.Alignment = StringAlignment.Near,
.LineAlignment = StringAlignment.Center,
.Trimming = StringTrimming.EllipsisCharacter,
.FormatFlags = StringFormatFlags.NoWrap
}
End Sub
#End Region
#Region "Paint"
Protected Overrides Sub OnDrawNode(e As DrawTreeNodeEventArgs)
MyBase.OnDrawNode(e)
If e.Node Is Nothing Then Return
Dim rect As Rectangle = e.Bounds : rect.Inflate(0, 1)
If Not ClientRectangle.IntersectsWith(rect) Then
Return
End If
Dim G As Graphics = e.Graphics
G.SmoothingMode = SmoothingMode.HighQuality
G.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
'Option1: If you want to draw different background color for the selected node.
'If (e.State And TreeNodeStates.Selected) = TreeNodeStates.Selected Then
' Using br As New SolidBrush(Color.LightSteelBlue) '<- suit yourself!
' G.FillRectangle(br, rect)
' End Using
'Else
' Using br As New SolidBrush(If(e.Node.BackColor.Equals(Color.Empty), BackColor, e.Node.BackColor))
' G.FillRectangle(br, rect)
' End Using
'End If
'Option2: If you don't want Option1.
Using br As New SolidBrush(If(e.Node.BackColor.Equals(Color.Empty), BackColor, e.Node.BackColor))
G.FillRectangle(br, rect)
End Using
Using br As New SolidBrush(If(e.Node.ForeColor.Equals(Color.Empty), ForeColor, e.Node.ForeColor))
G.DrawString(e.Node.Text, If(e.Node.NodeFont, Font), br, rect, NSF)
End Using
If ReferenceEquals(e.Node, HoverNode) Then
RightImageRect = New Rectangle(rect.Right + 5,
rect.Y + ((rect.Height - RightImage.Height) / 2),
rect.Height - 4, rect.Height - 4)
G.DrawImage(RightImage,
RightImageRect,
New Rectangle(0, 0, RightImage.Width, RightImage.Height),
GraphicsUnit.Pixel)
End If
End Sub
#End Region
#Region "Other Events"
'You need this to reduce the flickering.
Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
SendMessage(
Handle,
TVM_SETEXTENDEDSTYLE,
IntPtr.op_Explicit(TVS_EX_DOUBLEBUFFER),
IntPtr.op_Explicit(TVS_EX_DOUBLEBUFFER)
)
MyBase.OnHandleCreated(e)
End Sub
Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
MyBase.OnMouseMove(e)
Dim node = GetNodeAt(e.Location)
If node IsNot Nothing Then
'Avoid unnecessary Invalidate() calls.
If Not ReferenceEquals(node, HoverNode) Then
HoverNode = node
Invalidate()
End If
Else
'Avoid unnecessary Invalidate() calls.
If HoverNode IsNot Nothing Then
HoverNode = Nothing
Invalidate()
End If
End If
End Sub
Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
MyBase.OnMouseDown(e)
If e.Button = MouseButtons.Left AndAlso
RightImageRect.Contains(e.Location) Then
'Notify the container to do something.
OnEditButtonClicked()
End If
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
MyBase.OnMouseLeave(e)
Invalidate()
End Sub
Protected Overrides Sub Dispose(disposing As Boolean)
MyBase.Dispose(disposing)
If disposing Then
RightImage.Dispose()
NSF.Dispose()
End If
End Sub
#End Region
#Region "Custom Events"
Public Class EditButtonClickArgs
Inherits EventArgs
Public Property Node As TreeNode
Sub New(node As TreeNode)
Me.Node = node
End Sub
End Class
''' <summary>
''' Raised when the right image is clicked.
''' </summary>
Public Event EditButtonClicked As EventHandler(Of EditButtonClickArgs)
''' <summary>
''' Raises the <see cref="EditButtonClicked"/> events.
''' </summary>
Protected Overridable Sub OnEditButtonClicked()
RaiseEvent EditButtonClicked(Me, New EditButtonClickArgs(HoverNode))
End Sub
#End Region
End Class
In the Form that contains the new TreeViewEx control, you can handle the EditButtonClicked to do the necessary:
Public Class Form1
Inherits Form
Private Sub TreeViewEx1_EditButtonClicked(sender As Object, e As TreeViewEx.EditButtonClickArgs) Handles TreeViewEx1.EditButtonClicked
'Do something with the e.Node
End Sub
End Class
And here's a quick demo:
Good luck.
I'm trying to create a class for custom button control that will have 2 ingradient top and bottom color with rounded corners.
Below is the code that gives me two gradients color on top and bottom. However, I'm facing some issue with this where mouse hover property is not working and image also not showing (since new ingredients color overlaping the button text and image that is hidden in the back of ingradients color)
Can somebody help me with this control where all the control should work like they work with windows button control in addition to gradient color and rounded corners?
Please let me know in case you require any additional information.
Thanks in advance.
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Class MyButton
Inherits Button
Private m_TopColor As Color = Color.LightGreen
Private m_BottomColor As Color = Color.Orange
Public Property TopColor As Color
Get
Return m_TopColor
End Get
Set(ByVal value As Color)
m_TopColor = value
Me.Invalidate()
End Set
End Property
Public Property BottomColor As Color
Get
Return m_BottomColor
End Get
Set(ByVal value As Color)
m_BottomColor = value
Me.Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
Using lgb As LinearGradientBrush = New LinearGradientBrush(Me.ClientRectangle, m_TopColor, m_BottomColor, 90.0F)
Using textBrush As SolidBrush = New SolidBrush(Me.ForeColor)
Using format As StringFormat = New StringFormat()
format.Alignment = GetHorizontalAlignment()
format.LineAlignment = GetVerticalAlignment()
e.Graphics.FillRectangle(lgb, Me.ClientRectangle)
e.Graphics.DrawString(Me.Text, Me.Font, textBrush, Me.ClientRectangle, format)
End Using
End Using
End Using
End Sub
Private Function GetVerticalAlignment() As StringAlignment
Return CType(Math.Log(Me.TextAlign, 2D) / 4, StringAlignment)
End Function
Private Function GetHorizontalAlignment() As StringAlignment
Return CType(Math.Log(Me.TextAlign, 2D) Mod 4, StringAlignment)
End Function
End Class
customize a rounded button,code:
Imports System.Drawing.Drawing2D
Class MyButton
Inherits Button
Private m_TopColor As Color = Color.LightGreen
Private m_BottomColor As Color = Color.Orange
Public Property TopColor As Color
Get
Return m_TopColor
End Get
Set(ByVal value As Color)
m_TopColor = value
Me.Invalidate()
End Set
End Property
Public Property BottomColor As Color
Get
Return m_BottomColor
End Get
Set(ByVal value As Color)
m_BottomColor = value
Me.Invalidate()
End Set
End Property
Public Sub New()
FlatStyle = FlatStyle.Flat
FlatAppearance.BorderSize = 0
FlatAppearance.BorderColor = Color.FromArgb(0, 0, 0, 0)
FlatAppearance.MouseDownBackColor = Color.Transparent
FlatAppearance.MouseOverBackColor = Color.Transparent
BackColor = Color.Transparent
Me.BackgroundImageLayout = ImageLayout.Zoom
AddHandler Me.MouseMove, AddressOf MyMouseMove
AddHandler Me.MouseLeave, AddressOf MyMouseLeave
End Sub
Private Sub MyMouseLeave(ByVal sender As Object, ByVal e As EventArgs)
End Sub
Private Sub MyMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
End Sub
Private Sub Draw(ByVal rectangle As Rectangle, ByVal g As Graphics, ByVal cusp As Boolean)
Dim span As Integer = 2
g.SmoothingMode = SmoothingMode.AntiAlias
Dim myLinearGradientBrush As LinearGradientBrush = New LinearGradientBrush(Me.ClientRectangle, m_TopColor, m_BottomColor, 90.0F)
g.FillPath(myLinearGradientBrush, DrawRoundRect(rectangle.X, rectangle.Y, rectangle.Width - span, rectangle.Height - 1, 20))
End Sub
Private Function DrawRoundRect(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal radius As Integer) As GraphicsPath
Dim gp As GraphicsPath = New GraphicsPath()
gp.AddArc(x, y, radius, radius, 180, 90)
gp.AddArc(width - radius, y, radius, radius, 270, 90)
gp.AddArc(width - radius, height - radius, radius, radius, 0, 90)
gp.AddArc(x, height - radius, radius, radius, 90, 90)
gp.CloseAllFigures()
Return gp
End Function
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
Draw(e.ClipRectangle, e.Graphics, False)
End Sub
Private Function GetVerticalAlignment() As StringAlignment
Return CType(Math.Log(Me.TextAlign, 2D) / 4, StringAlignment)
End Function
Private Function GetHorizontalAlignment() As StringAlignment
Return CType(Math.Log(Me.TextAlign, 2D) Mod 4, StringAlignment)
End Function
End Class
I created an Borderless Windows Form and added the functionalities of the default System Header:
Moving:
Private m_blnMouseDown As Boolean = False
Private m_utdMouseOffset As Point
' Left mouse button pressed
Private Sub BorderlessMove_MouseDown(sender As Object, e As MouseEventArgs) Handles tlpHeader.MouseDown
If e.Button = MouseButtons.Left Then
' Get the new position
Dim mouseRelative As Point = Me.PointToClient(Cursor.Position)
m_utdMouseOffset = New Point(-mouseRelative.X, -mouseRelative.Y)
' Set that left button is pressed
m_blnMouseDown = True
End If
End Sub
' MouseMove used to check if mouse cursor is moving
Private Sub BorderlessMove_MouseMove(sender As Object, e As MouseEventArgs) Handles tlpHeader.MouseMove
If m_blnMouseDown Then
Dim mousePos As Point = Control.MousePosition
' Get the new form position
mousePos.Offset(m_utdMouseOffset.X, m_utdMouseOffset.Y)
Me.Location = mousePos
End If
End Sub
' Left mouse button released, form should stop moving
Private Sub BorderlessMove_MouseUp(sender As Object, e As MouseEventArgs) Handles tlpHeader.MouseUp
If e.Button = MouseButtons.Left Then
m_blnMouseDown = False
End If
End Sub
Resizing:
Private Enum ResizeState
North
NE
East
SE
South
SW
West
NW
None
End Enum
Private m_utdResizeState As ResizeState = ResizeState.None
Private Const GRIP_SIZE As Int32 = 5
Private Sub BorderlessResize_FormLoad(sender As Object, e As EventArgs) Handles Me.Load
Const DGRIP_SIZE As Int32 = GRIP_SIZE * 2
Dim Sizes As New Dictionary(Of String, Size)
Sizes.Add("Horizontal", New Size(Me.Width - DGRIP_SIZE * 2, GRIP_SIZE))
Sizes.Add("Vertical", New Size(GRIP_SIZE, Me.Height - DGRIP_SIZE * 2))
Sizes.Add("HEdge", New Size(DGRIP_SIZE, GRIP_SIZE))
Sizes.Add("VEdge", New Size(GRIP_SIZE, DGRIP_SIZE))
GenerateTransparentPanel("pnlResizeNorth", ResizeState.North, Sizes.Item("Horizontal"), New Point(DGRIP_SIZE, 0), (AnchorStyles.Top Or AnchorStyles.Right) Or AnchorStyles.Left)
GenerateTransparentPanel("pnlResizeNE_H", ResizeState.NE, Sizes.Item("HEdge"), New Point(Me.Width - DGRIP_SIZE, 0), AnchorStyles.Top Or AnchorStyles.Right)
GenerateTransparentPanel("pnlResizeNE_V", ResizeState.NE, Sizes.Item("VEdge"), New Point(Me.Width - GRIP_SIZE, 0), AnchorStyles.Top Or AnchorStyles.Right)
GenerateTransparentPanel("pnlResizeEast", ResizeState.East, Sizes.Item("Vertical"), New Point(Me.Width - GRIP_SIZE, DGRIP_SIZE), (AnchorStyles.Top Or AnchorStyles.Right) Or AnchorStyles.Bottom)
GenerateTransparentPanel("pnlResizeSE_H", ResizeState.SE, Sizes.Item("HEdge"), New Point(Me.Width - DGRIP_SIZE, Me.Height - GRIP_SIZE), AnchorStyles.Right Or AnchorStyles.Bottom)
GenerateTransparentPanel("pnlResizeSE_V", ResizeState.SE, Sizes.Item("VEdge"), New Point(Me.Width - GRIP_SIZE, Me.Height - DGRIP_SIZE), AnchorStyles.Right Or AnchorStyles.Bottom)
GenerateTransparentPanel("pnlResizeSouth", ResizeState.South, Sizes.Item("Horizontal"), New Point(DGRIP_SIZE, Me.Height - GRIP_SIZE), (AnchorStyles.Bottom Or AnchorStyles.Right) Or AnchorStyles.Left)
GenerateTransparentPanel("pnlResizeSW_H", ResizeState.SW, Sizes.Item("HEdge"), New Point(0, Me.Height - GRIP_SIZE), AnchorStyles.Bottom Or AnchorStyles.Left)
GenerateTransparentPanel("pnlResizeSW_V", ResizeState.SW, Sizes.Item("VEdge"), New Point(0, Me.Height - DGRIP_SIZE), AnchorStyles.Bottom Or AnchorStyles.Left)
GenerateTransparentPanel("pnlResizeWest", ResizeState.West, Sizes.Item("Vertical"), New Point(0, DGRIP_SIZE), (AnchorStyles.Top Or AnchorStyles.Left) Or AnchorStyles.Bottom)
GenerateTransparentPanel("pnlResizeNW_H", ResizeState.NW, Sizes.Item("HEdge"), New Point(0, 0), AnchorStyles.Top Or AnchorStyles.Left)
GenerateTransparentPanel("pnlResizeNW_V", ResizeState.NW, Sizes.Item("VEdge"), New Point(0, 0), AnchorStyles.Top Or AnchorStyles.Left)
End Sub
Private Sub GenerateTransparentPanel(name As String, tag As ResizeState, size As Size, location As Point, anchors As AnchorStyles)
Dim panel As TransparentPanel = New TransparentPanel()
panel.Anchor = anchors
panel.Location = location
panel.Name = name
panel.Size = size
panel.Tag = tag
AddHandler panel.MouseDown, AddressOf BorderlessResize_MouseDown
AddHandler panel.MouseMove, AddressOf BorderlessResize_MouseMove
AddHandler panel.MouseUp, AddressOf BorderlessResize_MouseUp
AddHandler panel.MouseEnter, AddressOf BorderlessResize_MouseEnter
AddHandler panel.MouseLeave, AddressOf BorderlessResize_MouseLeave
Me.Controls.Add(panel)
panel.BringToFront()
End Sub
Private Sub BorderlessResize_MouseDown(sender As Object, e As MouseEventArgs)
Debug.Write("MouseDown")
If e.Button = MouseButtons.Left Then
m_utdResizeState = DirectCast(sender, Control).Tag
End If
End Sub
Protected Sub BorderlessResize_MouseMove(sender As Object, e As MouseEventArgs)
If m_utdResizeState <> ResizeState.None Then
BorderlessResize_ResizeForm(m_utdResizeState)
Refresh()
End If
End Sub
Protected Sub BorderlessResize_MouseEnter(sender As Object, e As EventArgs)
BorderlessResize_UpdateCursor(DirectCast(sender, Control).Tag)
End Sub
Protected Sub BorderlessResize_MouseLeave(sender As Object, e As EventArgs)
Me.Cursor = Cursors.Default
End Sub
Private Sub BorderlessResize_UpdateCursor(state As ResizeState)
If (state = ResizeState.East OrElse state = ResizeState.West) Then
Me.Cursor = Cursors.SizeWE
ElseIf (state = ResizeState.North OrElse state = ResizeState.South) Then
Me.Cursor = Cursors.SizeNS
ElseIf (state = ResizeState.SE OrElse state = ResizeState.NW) Then
Me.Cursor = Cursors.SizeNWSE
ElseIf (state = ResizeState.NE OrElse state = ResizeState.SW) Then
Me.Cursor = Cursors.SizeNESW
Else Me.Cursor = Cursors.Default
End If
End Sub
Private Sub BorderlessResize_ResizeForm(ResizeVal As ResizeState)
Dim Location As Point = New Point(Cursor.Position.X - Me.Left, Cursor.Position.Y - Me.Top)
Select Case ResizeVal
Case ResizeState.North
If Me.Height - Location.Y <= Me.MinimumSize.Height Then Return
Me.Height = Me.Height - Location.Y
Me.Top = Me.Top + Location.Y
Exit Select
Case ResizeState.South
Me.Height = Location.Y
Exit Select
Case ResizeState.East
Me.Width = Location.X
Exit Select
Case ResizeState.West
If Me.Width - Location.X <= Me.MinimumSize.Width Then Return
Me.Width = Me.Width - Location.X
Me.Left = Me.Left + Location.X
Exit Select
Case ResizeState.NE
BorderlessResize_ResizeForm(ResizeState.North)
BorderlessResize_ResizeForm(ResizeState.East)
Exit Select
Case ResizeState.SE
BorderlessResize_ResizeForm(ResizeState.South)
BorderlessResize_ResizeForm(ResizeState.East)
Exit Select
Case ResizeState.SW
BorderlessResize_ResizeForm(ResizeState.South)
BorderlessResize_ResizeForm(ResizeState.West)
Exit Select
Case ResizeState.NW
BorderlessResize_ResizeForm(ResizeState.North)
BorderlessResize_ResizeForm(ResizeState.West)
Exit Select
End Select
End Sub
Protected Sub BorderlessResize_MouseUp(sender As Object, e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
m_utdResizeState = ResizeState.None
End If
End Sub
Default Context Menu
Private Const WS_SYSMENU As Integer = &H80000
Private Const WS_MINIMIZEBOX As Integer = &H20000
Private Const WS_MAXIMIZEBOX As Integer = &H10000
Protected Overrides ReadOnly Property CreateParams As System.Windows.Forms.CreateParams
Get
Dim p = MyBase.CreateParams
p.Style = WS_SYSMENU + WS_MINIMIZEBOX + WS_MAXIMIZEBOX
Return p
End Get
End Property
<DllImport("user32.dll")>
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer,
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
Private Const WM_POPUPSYSTEMMENU = &H313
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
Dim p = MousePosition.X + (MousePosition.Y * &H10000)
SendMessage(Me.Handle, WM_POPUPSYSTEMMENU, 0, p)
End Sub
Moving and Resizing works just fine, but my Context Menu is always displayed in the top left corner and MOVE and SIZE Options are not working because they need the Default Window Frame which I removed.
So is there a possibility to implement my solutions for Moving and Resizing into the Context Menu?
Is
SOLUTION 1
with WndPrc Overwrite
Private Sub Header_MouseDown(sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Right Then
Dim p As IntPtr = ((MousePosition.Y * WindowStyles.WS_MAXIMIZEBOX) + (MousePosition.X And &HFFFF))
Dim test As IntPtr = SendMessage(Me.Handle, WindowMessages.WM_POPUPSYSMENU, 0, p)
End If
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
If (m.Msg = WindowMessages.WM_SYSCOMMAND)
'Do SOmething with m.wParam
Else
MyBase.WndProc(m)
End If
End Sub
SOLUTION 2
with TrackMenuBar
Private Sub Header_MouseDown(sender As Object, ByVal e As MouseEventArgs)
If e.Button = MouseButtons.Right Then'Alternate Solution
Dim sysMenu As IntPtr = GetSystemMenu(Me.Handle, False)
Dim cmd As IntPtr = TrackPopupMenu(
sysMenu,
TrackPopupMenuOptions.TOPALIGN Or
TrackPopupMenuOptions.NOANIMATION Or
TrackPopupMenuOptions.RETURNCMD Or
TrackPopupMenuOptions.LEFTALIGN Or
TrackPopupMenuOptions.RIGHTBUTTON,
MousePosition.X,
MousePosition.Y,
IntPtr.Zero,
Me.Handle,
IntPtr.Zero)
'Do Something with cmd
End If
End Sub
I am trying to place a custom user control over the top of a PictureBox control but I cannot seem for the life of me how to set the transparency of the user control so it doesn't chop out the PictureBox image.
My User Control consists of a RectangleShape with text in the middle to create a 'Badge' icon on top of an image (see pictures below). The PictureBox and User Control both sit inside a Panel control and I have set the PictureBox.SendToBack() property and UserControl.BringToFront() property.
What I am left with is this:
My Code looks like this:
Option Explicit On
Option Strict On
Imports Microsoft.VisualBasic.PowerPacks
Public Class BadgeIcon
Inherits UserControl
Private _value As Integer
Private canvas As New ShapeContainer
Private Badge_Icon As New RectangleShape
Private rect As New Rectangle
Private m_BorderColor As Color = Color.White
Private m_FillColor As Color = Color.Red
Private m_BorderThickness As Integer = 2
Private m_BadgeFont As New Font("Segoe UI", 7, FontStyle.Bold)
Private m_BadgeText As String
Private m_TextColor As New SolidBrush(Color.White)
Private m_TextSize As Size
Private m_TextPadding As Integer = 5
Public Property Value() As Integer
Get
Return _value
End Get
Set(value As Integer)
_value = value
m_BadgeText = CStr(_value)
m_TextSize = TextRenderer.MeasureText(m_BadgeText, m_BadgeFont)
rect.Width = m_TextSize.Width + m_TextPadding
rect.Height = m_TextSize.Height + m_TextPadding
Me.Refresh()
End Set
End Property
Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = &H20
Return cp
End Get
End Property
Sub New()
' This call is required by the designer.
InitializeComponent()
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
SetStyle(ControlStyles.Opaque, False)
SetStyle(ControlStyles.DoubleBuffer, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
SetStyle(ControlStyles.UserPaint, True)
Me.BackColor = Color.FromArgb(0, 0, 0, 0)
UpdateStyles()
' Add any initialization after the InitializeComponent() call.
canvas.Parent = Me
Badge_Icon.Parent = canvas
canvas.BackColor = Color.FromArgb(0, 0, 0, 0)
'Create Badge Icon
With Badge_Icon
.BackColor = Color.FromArgb(0, 0, 0, 0)
.BorderColor = m_BorderColor
.BorderWidth = m_BorderThickness
.BorderStyle = Drawing2D.DashStyle.Solid
.CornerRadius = 11
.FillColor = m_FillColor
.FillStyle = FillStyle.Solid
.SelectionColor = Color.Transparent
End With
AddHandler Badge_Icon.Paint, AddressOf BadgeIcon_Paint
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
DrawBadgeIcon(e)
End Sub
Public Sub DrawBadgeIcon(e As PaintEventArgs)
Try
'Alter the size of the icon to fix the text
With Badge_Icon
.Location = New Point(rect.Left + 1, rect.Top + 1)
.Size = New Size(rect.Width, rect.Height - 1)
End With
Catch ex As Exception
ErrorTrap(ex, "cls_NotificationBadgeIcon: DrawBadgeIcon()")
End Try
End Sub
Private Sub BadgeIcon_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)
Dim textRect As New Rectangle(2, 2, m_TextSize.Width + m_TextPadding - 1, m_TextSize.Height + m_TextPadding - 2)
'Draw the Text
Dim flags As New StringFormat
flags.Alignment = StringAlignment.Center
flags.LineAlignment = StringAlignment.Center
e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
e.Graphics.DrawString(m_BadgeText, m_BadgeFont, m_TextColor, textRect, flags)
End Sub
End Class
Then to add everything to my main form I call the following:
Dim pic As New PictureBox
pic.Image = My.Resources.Notifications
pic.SizeMode = PictureBoxSizeMode.StretchImage
pic.Location = New Point(21, 221)
pic.Size = New Size(42, 29)
pnlLeftMenuBar.Controls.Add(pic)
pic.SendToBack()
Dim Counter_Notify As New BadgeIcon
Counter_Notify.Location = New Point(50, 240)
pnlLeftMenuBar.Controls.Add(Counter_Notify)
Counter_Notify.BringToFront()
And simply use Counter_Notify.Value = 1 to update the counter value.
How can I remove the square rectangle chopping out the background image? Or should I be setting this up an entirely different way? I'm a little new to User Controls.
Any help appreciated. Thanks
Using the paint event you can draw right on the picturebox itself.
Private Sub pb__Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles pb.Paint
Dim bgRect As New Rectangle({x,y,width,height})
Dim textRect As New Rectangle(bgRect.X - {?}, bgRect.Y = {?}, width, height)
e.Graphics.FillEllipse(New SolidBrush(Color.Red), bgRect)
e.Graphics.DrawEllipse(New Pen(Color.White, 10), bgRect)
Using sf As New StringFormat
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
e.Graphics.DrawString("1", {your font}, {your brush}, textRect, sf)
End Using
End Sub
In my Application i want to move the control one side another side. That control inside the tablelayoutpanel. I would like to drag the control which is inside the panel and the panel is inside the table layout panel so first i remove the control form panel and add the control in form after that i drag the button control its make the issue not clearly dragging. (that means drag fast its not working properly). My Code is
Private Sub HandleDraggableControlMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseDown
Dim target As Control = TryCast(sender, Control)
Dim xWidth, xHeight As Integer
If (Not target Is Nothing) Then
xWidth = sender.Width
xHeight = sender.Height
sender.Parent.Controls.Remove(sender)
sender.Dock = DockStyle.None
sender.Width = xWidth
sender.Height = xHeight
Me.Controls.Add(sender)
Dim pt As Point = Me.PointToClient(target.PointToScreen(Point.Empty))
target.Location = pt
target.Parent = Me
target.BringToFront()
Me.isMouseDown = True
Me.cachedControlPos = pt
Me.cachedMousePos = Control.MousePosition
End If
End Sub
Private Sub HandleDraggableControlMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseMove
If (Me.isMouseDown) Then
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim x As Integer = (Me.cachedControlPos.X + (Control.MousePosition.X - Me.cachedMousePos.X))
Dim y As Integer = (Me.cachedControlPos.Y + (Control.MousePosition.Y - Me.cachedMousePos.Y))
target.Location = New Point(x, y)
'c2 = (c1 + (m2 - m1))
End If
End If
End Sub
Private Sub HandleDraggableControlMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseUp
Me.cachedControlPos = Point.Empty
Me.cachedMousePos = Point.Empty
Me.isMouseDown = False
End Sub
My problem is if drag the control fast the control not moved cursor only moved why?. What am doing wrong in my coding?. How is solve the problem?
You need to add the difference between the current mouse position m2 and the cached mouse position m1 to a cached control position c1 to give you the current control position c2.
c2 = (c1 + (m2 - m1))
Something like this:
sender.Location = New Point(
(cachedControlLocation.X + (e.X - startX)),
(cachedControlLocation.Y + (e.Y - startY))
)
Here's a sample form to show you how it works:
Public Class Form1
Public Sub New()
Me.InitializeComponent()
Me.ClientSize = New Size(800, 600)
Me.panel1 = New Panel() With {.Bounds = New Rectangle(10, 10, 300, 300), .BackColor = Color.Red}
Me.panel2 = New Panel() With {.Bounds = New Rectangle(10, 10, 200, 200), .BackColor = Color.Green}
Me.panel3 = New Panel() With {.Bounds = New Rectangle(10, 10, 100, 100), .BackColor = Color.Blue}
Me.panel2.Controls.Add(Me.panel3)
Me.panel1.Controls.Add(Me.panel2)
Me.Controls.Add(Me.panel1)
End Sub
Private Sub HandleDraggableControlMouseDown(sender As Object, e As MouseEventArgs) Handles panel1.MouseDown, panel2.MouseDown, panel3.MouseDown
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim pt As Point = Me.PointToClient(target.PointToScreen(Point.Empty))
target.Parent = Me
target.BringToFront()
target.Location = pt
Me.isMouseDown = True
Me.cachedControlPos = pt
Me.cachedMousePos = Control.MousePosition
End If
End Sub
Private Sub HandleDraggableControlMouseMove(sender As Object, e As MouseEventArgs) Handles panel1.MouseMove, panel2.MouseMove, panel3.MouseMove
If (Me.isMouseDown) Then
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim x As Integer = (Me.cachedControlPos.X + (Control.MousePosition.X - Me.cachedMousePos.X))
Dim y As Integer = (Me.cachedControlPos.Y + (Control.MousePosition.Y - Me.cachedMousePos.Y))
target.Location = New Point(x, y)
'c2 = (c1 + (m2 - m1))
End If
End If
End Sub
Private Sub HandleDraggableControlMouseUp(sender As Object, e As MouseEventArgs) Handles panel1.MouseUp, panel2.MouseUp, panel3.MouseUp
Me.cachedControlPos = Point.Empty
Me.cachedMousePos = Point.Empty
Me.isMouseDown = False
End Sub
Private cachedMousePos As Point
Private cachedControlPos As Point
Private isMouseDown As Boolean
Private WithEvents panel1 As Panel
Private WithEvents panel2 As Panel
Private WithEvents panel3 As Panel
End Class
Update 1
It's important that you set the new location after you've changed the parent and moved it to the front.
target.Parent = Me
target.BringToFront()
target.Location = pt '<---
Update 2
So I've narrowed it down to what's causing this issue, and it turns out to be the Selectable control style. You can verify this by subclassing the button class and remove the style in the constructor.
Public Class UIButton
Inherits Button
Public Sub New()
MyBase.SetStyle(ControlStyles.Selectable, False)
End Sub
End Class
So how can we fix this? Well, AFAIK there's no easy solution. It's to be expected that a selectable control will process the mouse messages in a different way than those who can't. The only way I can think of (and it might be a dirty one) is to subclass the control(s) and intercept the mouse messages. The following code is not a final solution, so use it with caution.
Public Class UIButton
Inherits Button
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM.LBUTTONDOWN
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
MyBase.OnMouseDown(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
Exit Select
Case WM.MOVE
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
If (vk = Keys.LButton) Then
MyBase.OnMouseMove(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
End If
Exit Select
Case WM.LBUTTONUP
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
MyBase.OnMouseUp(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
Exit Select
End Select
MyBase.WndProc(m)
End Sub
Private Enum WM As Integer
MOVE = &H200
LBUTTONDOWN = &H201
LBUTTONUP = &H202
End Enum
<StructLayout(LayoutKind.Explicit)> _
Private Structure DWORD
<FieldOffset(0)> Public value As Integer
<FieldOffset(0)> Public loword As Short
<FieldOffset(2)> Public hiword As Short
End Structure
End Class