262 lines
9.2 KiB
VB.net
262 lines
9.2 KiB
VB.net
Imports System.Drawing
|
|
Imports System.Windows.Forms
|
|
|
|
Imports Pilz.Win32
|
|
|
|
Friend Class HighlightPanel
|
|
Inherits Control
|
|
|
|
Private _Highlights As Dictionary(Of Control, eHighlightColor) = Nothing
|
|
Private _HighlightRegions As List(Of HighlightRegion) = New List(Of HighlightRegion)()
|
|
|
|
Public Sub New(ByVal highlights As Dictionary(Of Control, eHighlightColor))
|
|
_Highlights = highlights
|
|
Me.SetStyle(ControlStyles.UserPaint, True)
|
|
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
|
|
Me.SetStyle(ControlStyles.Opaque, True)
|
|
Me.SetStyle(ControlStyles.ResizeRedraw, True)
|
|
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
|
|
Me.SetStyle(ControlStyles.Selectable, False)
|
|
End Sub
|
|
|
|
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
|
|
Dim g As Graphics = e.Graphics
|
|
g.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.AntiAlias
|
|
|
|
For Each highlightRegion As HighlightRegion In _HighlightRegions
|
|
Dim colors As Color() = GetHighlightColors(highlightRegion.HighlightColor)
|
|
Dim r As Rectangle = highlightRegion.Bounds
|
|
Dim back As Color = highlightRegion.BackColor
|
|
r.Inflate(1, 1)
|
|
DisplayHelp.FillRectangle(g, r, back)
|
|
r.Inflate(-1, -1)
|
|
DisplayHelp.FillRoundedRectangle(g, r, 2, colors(0))
|
|
r.Inflate(-2, -2)
|
|
DisplayHelp.DrawRectangle(g, colors(2), r)
|
|
r.Inflate(1, 1)
|
|
DisplayHelp.DrawRoundedRectangle(g, colors(1), r, 2)
|
|
Next
|
|
|
|
MyBase.OnPaint(e)
|
|
End Sub
|
|
|
|
Private Function GetHighlightColors(ByVal color As eHighlightColor) As Color()
|
|
Dim colors As Color() = New Color(2) {}
|
|
|
|
If color = eHighlightColor.Blue Then
|
|
colors(0) = GetColor(172, &H6A9CD4)
|
|
colors(1) = GetColor(&H6A9CD4)
|
|
colors(2) = GetColor(&H5D7EA4)
|
|
ElseIf color = eHighlightColor.Orange Then
|
|
colors(0) = GetColor(172, &HFF9C00)
|
|
colors(1) = GetColor(&HFF9C00)
|
|
colors(2) = GetColor(&HCC6600)
|
|
ElseIf color = eHighlightColor.Green Then
|
|
colors(0) = GetColor(172, &H71B171)
|
|
colors(1) = GetColor(&H71B171)
|
|
colors(2) = GetColor(&H339933)
|
|
ElseIf color = eHighlightColor.Custom Then
|
|
If _CustomHighlightColors Is Nothing OrElse _CustomHighlightColors.Length < 3 Then
|
|
colors(0) = System.Drawing.Color.Red
|
|
colors(1) = System.Drawing.Color.Red
|
|
colors(2) = System.Drawing.Color.Red
|
|
Else
|
|
colors(0) = _CustomHighlightColors(0)
|
|
colors(1) = _CustomHighlightColors(1)
|
|
colors(2) = _CustomHighlightColors(2)
|
|
End If
|
|
Else
|
|
colors(0) = GetColor(172, &HC63030)
|
|
colors(1) = GetColor(&HC63030)
|
|
colors(2) = GetColor(&H990000)
|
|
End If
|
|
|
|
Return colors
|
|
End Function
|
|
|
|
Protected Overrides Sub OnVisibleChanged(ByVal e As EventArgs)
|
|
If Me.Visible AndAlso Not _UpdatingRegion Then UpdateRegion()
|
|
MyBase.OnVisibleChanged(e)
|
|
End Sub
|
|
|
|
Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
|
|
If Not _RegionInitialized Then UpdateRegion()
|
|
MyBase.OnHandleCreated(e)
|
|
End Sub
|
|
|
|
Private _RegionInitialized As Boolean = False
|
|
Private _UpdatingRegion As Boolean = False
|
|
|
|
Friend Sub UpdateRegion()
|
|
If _UpdatingRegion OrElse Not Me.IsHandleCreated Then Return
|
|
|
|
Try
|
|
_UpdatingRegion = True
|
|
Me.Region = Nothing
|
|
_HighlightRegions.Clear()
|
|
If _Highlights Is Nothing Then Return
|
|
|
|
If _Highlights.Count = 0 AndAlso _FocusHighlightControl Is Nothing Then
|
|
Me.Visible = False
|
|
Return
|
|
End If
|
|
|
|
Dim processFocusControl As Boolean = True
|
|
Dim region As Region = Nothing
|
|
|
|
For Each item As KeyValuePair(Of Control, eHighlightColor) In _Highlights
|
|
If item.Value = eHighlightColor.None OrElse Not GetIsVisible(item.Key) Then Continue For
|
|
If item.Key Is _FocusHighlightControl Then processFocusControl = False
|
|
Dim r As Rectangle = GetControlRect(item.Key)
|
|
If r.IsEmpty Then Continue For
|
|
r.Inflate(2, 2)
|
|
_HighlightRegions.Add(New HighlightRegion(r, GetBackColor(item.Key.Parent), item.Value))
|
|
|
|
If region Is Nothing Then
|
|
region = New Region(r)
|
|
Else
|
|
region.Union(r)
|
|
End If
|
|
|
|
r.Inflate(-3, -3)
|
|
region.Exclude(r)
|
|
Next
|
|
|
|
If processFocusControl AndAlso _FocusHighlightControl IsNot Nothing AndAlso _FocusHighlightControl.Visible Then
|
|
Dim r As Rectangle = GetControlRect(_FocusHighlightControl)
|
|
|
|
If Not r.IsEmpty Then
|
|
r.Inflate(2, 2)
|
|
_HighlightRegions.Add(New HighlightRegion(r, GetBackColor(_FocusHighlightControl.Parent), _FocusHighlightColor))
|
|
|
|
If region Is Nothing Then
|
|
region = New Region(r)
|
|
Else
|
|
region.Union(r)
|
|
End If
|
|
|
|
r.Inflate(-3, -3)
|
|
region.Exclude(r)
|
|
End If
|
|
End If
|
|
|
|
Me.Region = region
|
|
|
|
If region Is Nothing Then
|
|
Me.Visible = False
|
|
ElseIf Not Me.Visible Then
|
|
Me.Visible = True
|
|
Me.BringToFront()
|
|
End If
|
|
|
|
Me.Invalidate()
|
|
Finally
|
|
_UpdatingRegion = False
|
|
_RegionInitialized = True
|
|
End Try
|
|
End Sub
|
|
|
|
Private Shared Function GetColor(rgb As Integer) As Color
|
|
If rgb = -1 Then
|
|
Return Color.Empty
|
|
Else
|
|
Return Color.FromArgb((rgb And &HFF0000) >> 16, (rgb And &HFF00) >> 8, rgb And &HFF)
|
|
End If
|
|
End Function
|
|
|
|
Private Shared Function GetColor(alpha As Integer, rgb As Integer) As Color
|
|
If rgb = -1 Then
|
|
Return Color.Empty
|
|
Else
|
|
Return Color.FromArgb(alpha, (rgb And &HFF0000) >> 16, (rgb And &HFF00) >> 8, rgb And &HFF)
|
|
End If
|
|
End Function
|
|
|
|
Private Function GetIsVisible(ByVal control As Control) As Boolean
|
|
If Not control.Visible Then Return False
|
|
If control.Parent Is Nothing OrElse Not control.IsHandleCreated Then Return control.Visible
|
|
Dim rect As New Native.RECT
|
|
Native.User32.GetWindowRect(control.Handle, rect)
|
|
Dim pp As Point = control.Parent.PointToClient(New Point(rect.Left + 3, rect.Top + 3))
|
|
Dim handle As IntPtr = Native.User32.ChildWindowFromPointEx(control.Parent.Handle, New Native.POINT(pp.X, pp.Y), CUInt(Native.WindowFromPointFlags.CWP_SKIPINVISIBLE))
|
|
If handle = IntPtr.Zero Then Return control.Visible
|
|
Dim c As Control = Control.FromHandle(handle)
|
|
|
|
If c IsNot Nothing AndAlso c IsNot control AndAlso c IsNot Me AndAlso c IsNot control.Parent Then
|
|
Return False
|
|
End If
|
|
|
|
Return control.Visible
|
|
End Function
|
|
|
|
Private Function GetBackColor(ByVal control As Control) As Color
|
|
Dim backColor As Color = control.BackColor
|
|
|
|
If backColor.IsEmpty OrElse backColor = Color.Transparent Then
|
|
backColor = SystemColors.Control
|
|
ElseIf backColor.A < 255 Then
|
|
backColor = Color.FromArgb(255, backColor)
|
|
End If
|
|
|
|
Return backColor
|
|
End Function
|
|
|
|
Protected Overrides Sub OnResize(ByVal e As EventArgs)
|
|
UpdateRegion()
|
|
MyBase.OnResize(e)
|
|
End Sub
|
|
|
|
Private Function GetControlRect(ByVal c As Control) As Rectangle
|
|
If Not c.IsHandleCreated Then Return Rectangle.Empty
|
|
Dim rect As Native.RECT
|
|
Native.User32.GetWindowRect(c.Handle, rect)
|
|
Dim p As Point = Me.PointToClient(rect.Location)
|
|
Return New Rectangle(p, rect.Size)
|
|
End Function
|
|
|
|
Private Structure HighlightRegion
|
|
Public Bounds As Rectangle
|
|
Public BackColor As Color
|
|
Public HighlightColor As eHighlightColor
|
|
|
|
Public Sub New(ByVal bounds As Rectangle, ByVal backColor As Color, ByVal highlightColor As eHighlightColor)
|
|
Me.Bounds = bounds
|
|
Me.BackColor = backColor
|
|
Me.HighlightColor = highlightColor
|
|
End Sub
|
|
End Structure
|
|
|
|
Private _FocusHighlightControl As Control
|
|
|
|
Public Property FocusHighlightControl As Control
|
|
Get
|
|
Return _FocusHighlightControl
|
|
End Get
|
|
Set(ByVal value As Control)
|
|
_FocusHighlightControl = value
|
|
End Set
|
|
End Property
|
|
|
|
Private _FocusHighlightColor As eHighlightColor = eHighlightColor.Blue
|
|
|
|
Public Property FocusHighlightColor As eHighlightColor
|
|
Get
|
|
Return _FocusHighlightColor
|
|
End Get
|
|
Set(ByVal value As eHighlightColor)
|
|
_FocusHighlightColor = value
|
|
End Set
|
|
End Property
|
|
|
|
Private _CustomHighlightColors As Color() = Nothing
|
|
|
|
Public Property CustomHighlightColors As Color()
|
|
Get
|
|
Return _CustomHighlightColors
|
|
End Get
|
|
Set(ByVal value As Color())
|
|
_CustomHighlightColors = value
|
|
End Set
|
|
End Property
|
|
End Class
|