From e7e83b9597a13bf7e7970db7f5920f6b7c1b2557 Mon Sep 17 00:00:00 2001 From: Pilzinsel64 Date: Mon, 27 Jun 2022 20:33:12 +0200 Subject: [PATCH 1/2] add some more native functions for Highlighter --- Pilz.Win32/Native/POINT.vb | 21 ++++++ Pilz.Win32/Native/RECT.vb | 82 +++++++++++++++++++++++ Pilz.Win32/Native/User32.vb | 17 +++++ Pilz.Win32/Native/WindowFromPointFlags.vb | 11 +++ 4 files changed, 131 insertions(+) create mode 100644 Pilz.Win32/Native/POINT.vb create mode 100644 Pilz.Win32/Native/RECT.vb create mode 100644 Pilz.Win32/Native/User32.vb create mode 100644 Pilz.Win32/Native/WindowFromPointFlags.vb diff --git a/Pilz.Win32/Native/POINT.vb b/Pilz.Win32/Native/POINT.vb new file mode 100644 index 0000000..e967331 --- /dev/null +++ b/Pilz.Win32/Native/POINT.vb @@ -0,0 +1,21 @@ +Imports System.Runtime.InteropServices + +Namespace Native + + + Public Structure POINT + Public Sub New(ByVal p As System.Drawing.Point) + Me.x = p.X + Me.y = p.Y + End Sub + + Public Sub New(ByVal x As Integer, ByVal y As Integer) + Me.x = x + Me.y = y + End Sub + + Public x As Integer + Public y As Integer + End Structure + +End Namespace diff --git a/Pilz.Win32/Native/RECT.vb b/Pilz.Win32/Native/RECT.vb new file mode 100644 index 0000000..650ecba --- /dev/null +++ b/Pilz.Win32/Native/RECT.vb @@ -0,0 +1,82 @@ +Imports System.Drawing +Imports System.Runtime.InteropServices + +Namespace Native + + + Public Structure RECT + Public Left As Integer + Public Top As Integer + Public Right As Integer + Public Bottom As Integer + + Public Sub New(ByVal left_ As Integer, ByVal top_ As Integer, ByVal right_ As Integer, ByVal bottom_ As Integer) + Left = left_ + Top = top_ + Right = right_ + Bottom = bottom_ + End Sub + + Public Sub New(ByVal r As Rectangle) + Left = r.Left + Top = r.Top + Right = r.Right + Bottom = r.Bottom + End Sub + + Public ReadOnly Property Height As Integer + Get + Return Bottom - Top + End Get + End Property + + Public ReadOnly Property Width As Integer + Get + Return Right - Left + End Get + End Property + + Public ReadOnly Property Size As System.Drawing.Size + Get + Return New System.Drawing.Size(Width, Height) + End Get + End Property + + Public ReadOnly Property Location As System.Drawing.Point + Get + Return New System.Drawing.Point(Left, Top) + End Get + End Property + + Public Function ToRectangle() As Rectangle + Return Rectangle.FromLTRB(Left, Top, Right, Bottom) + End Function + + Public Shared Function FromRectangle(ByVal rectangle As Rectangle) As RECT + Return New RECT(rectangle.Left, rectangle.Top, rectangle.Right, rectangle.Bottom) + End Function + + Public Overrides Function GetHashCode() As Integer + Return Left ^ ((Top << 13) Or (Top >> &H13)) _ + ^ ((Width << &H1A) Or (Width >> 6)) _ + ^ ((Height << 7) Or (Height >> &H19)) + End Function + + Public Shared Function FromXYWH(ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As RECT + Return New RECT(x, y, x + width, y + height) + End Function + + Public Shared Widening Operator CType(ByVal rect As RECT) As Rectangle + Return Rectangle.FromLTRB(rect.Left, rect.Top, rect.Right, rect.Bottom) + End Operator + + Public Shared Widening Operator CType(ByVal rect As Rectangle) As RECT + Return New RECT(rect.Left, rect.Top, rect.Right, rect.Bottom) + End Operator + + Public Overrides Function ToString() As String + Return "Left=" & Me.Left & ", Top=" & Me.Top & ", Right=" & Me.Right & ", Bottom=" & Me.Bottom + End Function + End Structure + +End Namespace diff --git a/Pilz.Win32/Native/User32.vb b/Pilz.Win32/Native/User32.vb new file mode 100644 index 0000000..d10c083 --- /dev/null +++ b/Pilz.Win32/Native/User32.vb @@ -0,0 +1,17 @@ +Imports System.Runtime.InteropServices + +Namespace Native + + Public Class User32 + + + Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef r As RECT) As Boolean + End Function + + + Public Shared Function ChildWindowFromPointEx(ByVal hWndParent As IntPtr, ByVal pt As POINT, ByVal uFlags As UInteger) As IntPtr + End Function + + End Class + +End Namespace diff --git a/Pilz.Win32/Native/WindowFromPointFlags.vb b/Pilz.Win32/Native/WindowFromPointFlags.vb new file mode 100644 index 0000000..e127c8c --- /dev/null +++ b/Pilz.Win32/Native/WindowFromPointFlags.vb @@ -0,0 +1,11 @@ +Namespace Native + + + Public Enum WindowFromPointFlags + CWP_ALL = &H0 + CWP_SKIPINVISIBLE = &H1 + CWP_SKIPDISABLED = &H2 + CWP_SKIPTRANSPARENT = &H4 + End Enum + +End Namespace \ No newline at end of file From 5002077d9ac207afa2c784be32f816e3adab6517 Mon Sep 17 00:00:00 2001 From: Pilzinsel64 Date: Mon, 27 Jun 2022 20:33:14 +0200 Subject: [PATCH 2/2] add Highlighter --- Pilz.UI/DisplayHelp.vb | 163 +++++++++++++++ Pilz.UI/HighlightPanel.vb | 261 ++++++++++++++++++++++++ Pilz.UI/Highlighter.vb | 409 ++++++++++++++++++++++++++++++++++++++ Pilz.UI/Pilz.UI.vbproj | 1 + 4 files changed, 834 insertions(+) create mode 100644 Pilz.UI/DisplayHelp.vb create mode 100644 Pilz.UI/HighlightPanel.vb create mode 100644 Pilz.UI/Highlighter.vb diff --git a/Pilz.UI/DisplayHelp.vb b/Pilz.UI/DisplayHelp.vb new file mode 100644 index 0000000..46b238d --- /dev/null +++ b/Pilz.UI/DisplayHelp.vb @@ -0,0 +1,163 @@ +Imports System.Drawing +Imports System.Drawing.Drawing2D + +Public Class DisplayHelp + + Public Shared Sub FillRectangle(ByVal g As Graphics, ByVal bounds As Rectangle, ByVal color1 As Color) + FillRectangle(g, bounds, color1, Color.Empty, 90) + End Sub + + Public Shared Sub FillRectangle(ByVal g As Graphics, ByVal bounds As Rectangle, ByVal color1 As Color, ByVal color2 As Color) + FillRectangle(g, bounds, color1, color2, 90) + End Sub + + Public Shared Sub FillRectangle(ByVal g As Graphics, ByVal r As Rectangle, ByVal color1 As Color, ByVal color2 As Color, ByVal gradientAngle As Integer) + If r.Width = 0 OrElse r.Height = 0 Then Return + + If color2.IsEmpty Then + + If Not color1.IsEmpty Then + Dim sm As SmoothingMode = g.SmoothingMode + g.SmoothingMode = SmoothingMode.None + + Using brush As SolidBrush = New SolidBrush(color1) + g.FillRectangle(brush, r) + End Using + + g.SmoothingMode = sm + End If + Else + + Using brush As LinearGradientBrush = CreateLinearGradientBrush(r, color1, color2, gradientAngle) + g.FillRectangle(brush, r) + End Using + End If + End Sub + + Public Shared Sub FillRectangle(ByVal g As Graphics, ByVal r As Rectangle, ByVal color1 As Color, ByVal color2 As Color, ByVal gradientAngle As Integer, ByVal factors As Single(), ByVal positions As Single()) + If r.Width = 0 OrElse r.Height = 0 Then Return + + If color2.IsEmpty Then + + If Not color1.IsEmpty Then + Dim sm As SmoothingMode = g.SmoothingMode + g.SmoothingMode = SmoothingMode.None + + Using brush As SolidBrush = New SolidBrush(color1) + g.FillRectangle(brush, r) + End Using + + g.SmoothingMode = sm + End If + Else + + Using brush As LinearGradientBrush = CreateLinearGradientBrush(r, color1, color2, gradientAngle) + Dim blend As Blend = New Blend(factors.Length) + blend.Factors = factors + blend.Positions = positions + brush.Blend = blend + g.FillRectangle(brush, r) + End Using + End If + End Sub + + Public Shared Sub FillRoundedRectangle(ByVal g As Graphics, ByVal bounds As Rectangle, ByVal cornerSize As Integer, ByVal color1 As Color, ByVal color2 As Color, ByVal gradientAngle As Integer) + If color2.IsEmpty Then + + If Not color1.IsEmpty Then + + Using brush As SolidBrush = New SolidBrush(color1) + FillRoundedRectangle(g, brush, bounds, cornerSize) + End Using + End If + Else + + Using brush As LinearGradientBrush = CreateLinearGradientBrush(bounds, color1, color2, gradientAngle) + FillRoundedRectangle(g, brush, bounds, cornerSize) + End Using + End If + End Sub + + Public Shared Sub FillRoundedRectangle(ByVal g As Graphics, ByVal bounds As Rectangle, ByVal cornerSize As Integer, ByVal color1 As Color, ByVal color2 As Color) + FillRoundedRectangle(g, bounds, cornerSize, color1, color2, 90) + End Sub + + Public Shared Sub FillRoundedRectangle(ByVal g As Graphics, ByVal bounds As Rectangle, ByVal cornerSize As Integer, ByVal color1 As Color) + Using brush As SolidBrush = New SolidBrush(color1) + FillRoundedRectangle(g, brush, bounds, cornerSize) + End Using + End Sub + + Public Shared Sub FillRoundedRectangle(ByVal g As Graphics, ByVal brush As Brush, ByVal bounds As Rectangle, ByVal cornerSize As Integer) + If cornerSize <= 0 Then + Dim sm As SmoothingMode = g.SmoothingMode + g.SmoothingMode = SmoothingMode.None + g.FillRectangle(brush, bounds) + g.SmoothingMode = sm + Else + bounds.Width -= 1 + bounds.Height -= 1 + + Using path As GraphicsPath = GetRoundedRectanglePath(bounds, cornerSize) + g.FillPath(brush, path) + End Using + End If + End Sub + + Public Shared Sub DrawRectangle(ByVal g As System.Drawing.Graphics, ByVal color As Color, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) + Using pen As Pen = New Pen(color, 1) + DrawRectangle(g, pen, x, y, width, height) + End Using + End Sub + + Public Shared Sub DrawRectangle(ByVal g As System.Drawing.Graphics, ByVal color As Color, ByVal r As System.Drawing.Rectangle) + DrawRectangle(g, color, r.X, r.Y, r.Width, r.Height) + End Sub + + Public Shared Sub DrawRectangle(ByVal g As System.Drawing.Graphics, ByVal pen As System.Drawing.Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) + width -= 1 + height -= 1 + g.DrawRectangle(pen, x, y, width, height) + End Sub + + Public Shared Sub DrawRoundedRectangle(ByVal g As System.Drawing.Graphics, ByVal color As Color, ByVal bounds As Rectangle, ByVal cornerSize As Integer) + If Not color.IsEmpty Then + + Using pen As Pen = New Pen(color) + DrawRoundedRectangle(g, pen, bounds.X, bounds.Y, bounds.Width, bounds.Height, cornerSize) + End Using + End If + End Sub + + Public Shared Sub DrawRoundedRectangle(ByVal g As System.Drawing.Graphics, ByVal pen As System.Drawing.Pen, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal cornerSize As Integer) + DrawRoundedRectangle(g, pen, Nothing, x, y, width, height, cornerSize) + End Sub + + Public Shared Sub DrawRoundedRectangle(ByVal g As System.Drawing.Graphics, ByVal pen As System.Drawing.Pen, ByVal fill As Brush, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal cornerSize As Integer) + width -= 1 + height -= 1 + Dim r As Rectangle = New Rectangle(x, y, width, height) + + Using path As GraphicsPath = GetRoundedRectanglePath(r, cornerSize) + If fill IsNot Nothing Then g.FillPath(fill, path) + g.DrawPath(pen, path) + End Using + End Sub + + Public Shared Function GetRoundedRectanglePath(ByVal r As Rectangle, ByVal cornerSize As Integer) As GraphicsPath + Dim path As GraphicsPath = New GraphicsPath() + + If cornerSize = 0 Then + path.AddRectangle(r) + End If + + Return path + End Function + + Public Shared Function CreateLinearGradientBrush(ByVal r As Rectangle, ByVal color1 As Color, ByVal color2 As Color, ByVal gradientAngle As Single) As LinearGradientBrush + If r.Width <= 0 Then r.Width = 1 + If r.Height <= 0 Then r.Height = 1 + Return New LinearGradientBrush(New Rectangle(r.X, r.Y - 1, r.Width, r.Height + 1), color1, color2, gradientAngle) + End Function + +End Class diff --git a/Pilz.UI/HighlightPanel.vb b/Pilz.UI/HighlightPanel.vb new file mode 100644 index 0000000..9eb7028 --- /dev/null +++ b/Pilz.UI/HighlightPanel.vb @@ -0,0 +1,261 @@ +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 & &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 & &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) + bounds = bounds + backColor = backColor + 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 diff --git a/Pilz.UI/Highlighter.vb b/Pilz.UI/Highlighter.vb new file mode 100644 index 0000000..00d69fd --- /dev/null +++ b/Pilz.UI/Highlighter.vb @@ -0,0 +1,409 @@ +Imports System +Imports System.Collections.Generic +Imports System.ComponentModel +Imports System.Windows.Forms +Imports System.Drawing + +Public Class Highlighter + Inherits Component + + Private _Highlights As Dictionary(Of Control, eHighlightColor) = New Dictionary(Of Control, eHighlightColor)() + Private _HighlightOnFocus As Dictionary(Of Control, Boolean) = New Dictionary(Of Control, Boolean)() + + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + If _ContainerControl IsNot Nothing Then + RemoveHandler _ContainerControl.SizeChanged, AddressOf ContainerControlSizeChanged + RemoveHandler _ContainerControl.HandleCreated, AddressOf ContainerControlHandleCreated + End If + + If _HighlightPanel IsNot Nothing AndAlso _HighlightPanel.Parent Is Nothing AndAlso Not _HighlightPanel.IsDisposed Then + _HighlightPanel.Dispose() + _HighlightPanel = Nothing + Else + _HighlightPanel = Nothing + End If + + MyBase.Dispose(disposing) + End Sub + + + Public Function GetHighlightOnFocus(ByVal c As Control) As Boolean + If _HighlightOnFocus.ContainsKey(c) Then + Return _HighlightOnFocus(c) + End If + + Return False + End Function + + Public Sub SetHighlightOnFocus(ByVal c As Control, ByVal highlight As Boolean) + If c Is Nothing Then Throw New NullReferenceException() + + If _HighlightOnFocus.ContainsKey(c) Then + + If Not highlight Then + RemoveHighlightOnFocus(_HighlightOnFocus, c) + End If + + Return + End If + + If highlight Then AddHighlightOnFocus(_HighlightOnFocus, c) + End Sub + + Private Sub AddHighlightOnFocus(ByVal highlightOnFocus As Dictionary(Of Control, Boolean), ByVal c As Control) + AddHandler c.Enter, AddressOf ControlHighlightEnter + AddHandler c.Leave, AddressOf ControlHighlightLeave + AddHandler c.VisibleChanged, AddressOf ControlHighlightVisibleChanged + highlightOnFocus.Add(c, True) + End Sub + + Private Sub ControlHighlightVisibleChanged(ByVal sender As Object, ByVal e As EventArgs) + If _HighlightPanel IsNot Nothing AndAlso _HighlightPanel.FocusHighlightControl = sender Then UpdateHighlighterRegion() + End Sub + + Private Sub ControlHighlightLeave(ByVal sender As Object, ByVal e As EventArgs) + If _HighlightPanel IsNot Nothing Then _HighlightPanel.FocusHighlightControl = Nothing + UpdateHighlighterRegion() + End Sub + + Private Sub ControlHighlightEnter(ByVal sender As Object, ByVal e As EventArgs) + If _HighlightPanel IsNot Nothing Then + If Not _HighlightPanel.Visible Then _HighlightPanel.Visible = True + _HighlightPanel.BringToFront() + _HighlightPanel.FocusHighlightControl = CType(sender, Control) + End If + + UpdateHighlighterRegion() + End Sub + + Private Sub RemoveHighlightOnFocus(ByVal highlightOnFocus As Dictionary(Of Control, Boolean), ByVal c As Control) + RemoveHandler c.Enter, AddressOf ControlHighlightEnter + RemoveHandler c.Leave, AddressOf ControlHighlightLeave + RemoveHandler c.VisibleChanged, AddressOf ControlHighlightVisibleChanged + highlightOnFocus.Remove(c) + End Sub + + + Public Function GetHighlightColor(ByVal c As Control) As eHighlightColor + If _Highlights.ContainsKey(c) Then + Return _Highlights(c) + End If + + Return eHighlightColor.None + End Function + + Public Sub SetHighlightColor(ByVal c As Control, ByVal highlightColor As eHighlightColor) + If _Highlights.ContainsKey(c) Then + + If highlightColor = eHighlightColor.None Then + RemoveHighlight(_Highlights, c) + Else + Dim color As eHighlightColor = _Highlights(c) + RemoveHighlight(_Highlights, c) + AddHighlight(_Highlights, c, highlightColor) + End If + ElseIf highlightColor <> eHighlightColor.None Then + AddHighlight(_Highlights, c, highlightColor) + End If + End Sub + + Private _TabControl2 As Dictionary(Of System.Windows.Forms.TabControl, Integer) = New Dictionary(Of System.Windows.Forms.TabControl, Integer)() + Private _ParentPanel As Dictionary(Of Panel, Integer) = New Dictionary(Of Panel, Integer)() + + Private Sub AddHighlight(ByVal highlights As Dictionary(Of Control, eHighlightColor), ByVal c As Control, ByVal highlightColor As eHighlightColor) + highlights.Add(c, highlightColor) + AddHandler c.LocationChanged, New EventHandler(AddressOf ControlLocationChanged) + AddHandler c.SizeChanged, New EventHandler(AddressOf ControlSizeChanged) + AddHandler c.VisibleChanged, New EventHandler(AddressOf ControlVisibleChanged) + + If _HighlightPanel IsNot Nothing Then + If Not _HighlightPanel.Visible Then _HighlightPanel.Visible = True + _HighlightPanel.BringToFront() + End If + + If c.Parent Is Nothing Then + AddHandler c.ParentChanged, AddressOf ControlParentChanged + Else + AddTabControlHandlers(c) + End If + + UpdateHighlighterRegion() + End Sub + + Private Sub ControlParentChanged(ByVal sender As Object, ByVal e As EventArgs) + Dim c As Control = CType(sender, Control) + RemoveHandler c.ParentChanged, AddressOf ControlParentChanged + AddTabControlHandlers(c) + End Sub + + Private Sub AddTabControlHandlers(ByVal c As Control) + Dim tab2 As System.Windows.Forms.TabControl = TryCast(GetParentControl(c, GetType(System.Windows.Forms.TabControl)), System.Windows.Forms.TabControl) + + If tab2 IsNot Nothing Then + + If _TabControl2.ContainsKey(tab2) Then + _TabControl2(tab2) = _TabControl2(tab2) + 1 + Else + _TabControl2.Add(tab2, 1) + AddHandler tab2.SelectedIndexChanged, AddressOf WinFormsTabSelectedIndexChanged + End If + Else + Dim parentPanel As Panel = TryCast(GetParentControl(c, GetType(Panel)), Panel) + + If parentPanel IsNot Nothing Then + + If _ParentPanel.ContainsKey(parentPanel) Then + _ParentPanel(parentPanel) = _ParentPanel(parentPanel) + 1 + Else + _ParentPanel.Add(parentPanel, 1) + AddHandler parentPanel.Resize, AddressOf ParentPanelResized + AddHandler parentPanel.LocationChanged, AddressOf ParentPanelLocationChanged + End If + End If + End If + End Sub + + Private Sub ParentPanelLocationChanged(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlights() + End Sub + + Private Sub ParentPanelResized(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlights() + End Sub + + Private Sub WinFormsTabSelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlighterRegion() + End Sub + + Private Function GetParentControl(ByVal c As Control, ByVal parentType As Type) As Control + Dim parent As Control = c.Parent + + While parent IsNot Nothing + If parentType.IsAssignableFrom(parent.[GetType]()) Then Return parent + parent = parent.Parent + End While + + Return Nothing + End Function + + Private Sub ControlVisibleChanged(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlighterRegion() + End Sub + + Private Sub ControlSizeChanged(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlighterRegion() + End Sub + + Private Sub ControlLocationChanged(ByVal sender As Object, ByVal e As EventArgs) + UpdateHighlighterRegion() + End Sub + + Private Sub UpdateHighlighterRegion() + If _HighlightPanel IsNot Nothing Then _HighlightPanel.UpdateRegion() + End Sub + + Public Sub UpdateHighlights() + UpdateHighlighterRegion() + End Sub + + Private Sub RemoveHighlight(ByVal highlights As Dictionary(Of Control, eHighlightColor), ByVal c As Control) + highlights.Remove(c) + RemoveHandler c.LocationChanged, New EventHandler(AddressOf ControlLocationChanged) + RemoveHandler c.SizeChanged, New EventHandler(AddressOf ControlSizeChanged) + RemoveHandler c.VisibleChanged, New EventHandler(AddressOf ControlVisibleChanged) + Dim tab2 As System.Windows.Forms.TabControl = TryCast(GetParentControl(c, GetType(System.Windows.Forms.TabControl)), System.Windows.Forms.TabControl) + + If tab2 IsNot Nothing Then + + If _TabControl2.ContainsKey(tab2) Then + + If _TabControl2(tab2) = 1 Then + _TabControl2.Remove(tab2) + RemoveHandler tab2.SelectedIndexChanged, AddressOf WinFormsTabSelectedIndexChanged + Else + _TabControl2(tab2) = _TabControl2(tab2) - 1 + End If + End If + Else + Dim parentPanel As Panel = TryCast(GetParentControl(c, GetType(Panel)), Panel) + + If parentPanel IsNot Nothing Then + + If _ParentPanel.ContainsKey(parentPanel) Then + + If _ParentPanel(parentPanel) = 1 Then + _ParentPanel.Remove(parentPanel) + RemoveHandler parentPanel.LocationChanged, AddressOf ParentPanelLocationChanged + RemoveHandler parentPanel.SizeChanged, AddressOf ParentPanelResized + Else + _ParentPanel(parentPanel) = _ParentPanel(parentPanel) - 1 + End If + End If + End If + End If + + UpdateHighlighterRegion() + End Sub + + Friend ReadOnly Property Highlights As Dictionary(Of Control, eHighlightColor) + Get + Return _Highlights + End Get + 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 + + If _HighlightPanel IsNot Nothing Then + _HighlightPanel.FocusHighlightColor = value + UpdateHighlighterRegion() + End If + End Set + End Property + + Private _HighlightPanel As HighlightPanel = Nothing + Private _ContainerControl As Control = Nothing + + + Public Property ContainerControl As Control + Get + Return _ContainerControl + End Get + Set(ByVal value As Control) + + If Me.DesignMode Then + _ContainerControl = value + Return + End If + + If _ContainerControl IsNot value Then + + If _ContainerControl IsNot Nothing Then + RemoveHandler _ContainerControl.SizeChanged, AddressOf ContainerControlSizeChanged + RemoveHandler _ContainerControl.HandleCreated, AddressOf ContainerControlHandleCreated + If _HighlightPanel IsNot Nothing AndAlso _HighlightPanel.Parent Is _ContainerControl Then _ContainerControl.Controls.Remove(_HighlightPanel) + End If + + _ContainerControl = value + + If _ContainerControl IsNot Nothing Then + + If _HighlightPanel Is Nothing Then + _HighlightPanel = New HighlightPanel(_Highlights) + _HighlightPanel.FocusHighlightColor = _FocusHighlightColor + _HighlightPanel.Margin = New System.Windows.Forms.Padding(0) + _HighlightPanel.Padding = New System.Windows.Forms.Padding(0) + _HighlightPanel.CustomHighlightColors = _CustomHighlightColors + _HighlightPanel.Visible = False + End If + + AddHandler _ContainerControl.SizeChanged, AddressOf ContainerControlSizeChanged + AddHandler _ContainerControl.HandleCreated, AddressOf ContainerControlHandleCreated + _ContainerControl.Controls.Add(_HighlightPanel) + UpdateHighlightPanelBounds() + End If + End If + End Set + End Property + + Private Sub ContainerControlHandleCreated(ByVal sender As Object, ByVal e As EventArgs) + If _Highlights.Count > 0 AndAlso _HighlightPanel IsNot Nothing AndAlso Not _HighlightPanel.Visible Then _HighlightPanel.Visible = True + End Sub + + Private Sub UpdateHighlightPanelBounds() + Dim bounds As Rectangle = New Rectangle(0, 0, _ContainerControl.ClientRectangle.Width, _ContainerControl.ClientRectangle.Height) + + If TypeOf _HighlightPanel.Parent Is Form Then + Dim form As Form = TryCast(_HighlightPanel.Parent, Form) + + If form.AutoSize Then + bounds.X += form.Padding.Left + bounds.Y += form.Padding.Top + bounds.Width -= form.Padding.Horizontal + bounds.Height -= form.Padding.Vertical + End If + End If + + If _HighlightPanel.Bounds.Equals(bounds) Then + _HighlightPanel.UpdateRegion() + Else + _HighlightPanel.Bounds = bounds + End If + + _HighlightPanel.BringToFront() + End Sub + + Private _DelayTimer As Timer = Nothing + + Private Sub ContainerControlSizeChanged(ByVal sender As Object, ByVal e As EventArgs) + Dim form As Form = TryCast(sender, Form) + + If form IsNot Nothing Then + + If _DelayTimer Is Nothing Then + _DelayTimer = New Timer() + _DelayTimer.Interval = 100 + AddHandler _DelayTimer.Tick, New EventHandler(AddressOf DelayTimerTick) + _DelayTimer.Start() + End If + + Return + End If + + UpdateHighlightPanelBounds() + End Sub + + Private Sub DelayTimerTick(ByVal sender As Object, ByVal e As EventArgs) + Dim timer As Timer = _DelayTimer + _DelayTimer = Nothing + RemoveHandler timer.Tick, New EventHandler(AddressOf DelayTimerTick) + timer.[Stop]() + timer.Dispose() + UpdateHighlightPanelBounds() + End Sub + + Private _CustomHighlightColors As Color() = Nothing + + + Public Property CustomHighlightColors As Color() + Get + Return _CustomHighlightColors + End Get + Set(ByVal value As Color()) + _CustomHighlightColors = value + + If _HighlightPanel IsNot Nothing Then + _HighlightPanel.CustomHighlightColors = _CustomHighlightColors + _HighlightPanel.Invalidate() + End If + End Set + End Property + + Public Function CanExtend(ByVal extendee As Object) As Boolean + Return (TypeOf extendee Is Control) + End Function + + Private Sub SetError(ByVal control As Control, ByVal value As String) + Me.SetHighlightColor(control, eHighlightColor.Red) + End Sub + + Private Sub ClearError(ByVal control As Control) + Me.SetHighlightColor(control, eHighlightColor.None) + End Sub +End Class + +Public Enum eHighlightColor + None + Red + Blue + Green + Orange + Custom +End Enum diff --git a/Pilz.UI/Pilz.UI.vbproj b/Pilz.UI/Pilz.UI.vbproj index 67cea06..425919f 100644 --- a/Pilz.UI/Pilz.UI.vbproj +++ b/Pilz.UI/Pilz.UI.vbproj @@ -100,5 +100,6 @@ + \ No newline at end of file