.netvb.netinheritancepropertiescolordialog

Adding Title & Location properties to this custom ColorDialog


I've taken a piece from a custom Colordialog class and another piece of other custom Colordialog.

The first class have implemented the Title property.

This is the first class (The marked answer translated to VBNET) : How do I change the title of ColorDialog?

The second class have implemented the realtime pick of the colors.

This is the second class (The marked answer): Get color property while ColorDialog still open, before confirming the dialog?

Unafortunatelly for the Location property I don't know nothing about how to implement it into a dialog even been searched for a solution.

Well, now I'm trying to merge the two pieces of code to get a powerfull "default" ColorDialog.

The custom ColorDialog class translated to VB.NET with Title property is working but when I try to merge the two classes the title property is not working, I can change the title value in the property field but is not showing any title (the ColorDialog title is empty).

My question is what changes I need to make to this class to work properly the Title property and if how I can implement a "Location" property to easy relocate the ColorDialog over the screen if i desire, for example: MyColorDialog.Location = new point(), I've tried it time ago using the RECT structure.

This is the important part of the merged class where I made changes :

(The Title property things are regioned and commented in separate.)

Imports System.Runtime.InteropServices

Public Class Colordialog_Realtime
    Inherits ColorDialog

#Region " Title property things"

    <DllImport("user32.dll")> _
    Private Shared Function SetWindowText(hWnd As IntPtr, lpString As String) As Boolean
    End Function

    Private m_title As String = String.Empty
    Private titleSet As Boolean = False

    Public Property Title() As String
        Get
            Return m_title
        End Get
        Set(value As String)
            If value IsNot Nothing AndAlso value <> m_title Then
                m_title = value
                titleSet = False
            End If
        End Set
    End Property

#End Region

    Public Event CurrentColor(ByVal c As Color)

    Private Const GA_ROOT As Integer = 2
    Private Const WM_CTLCOLOREDIT As Integer = &H133

    Public Declare Function GetAncestor Lib "user32.dll" _
        (ByVal hWnd As IntPtr, ByVal gaFlags As Integer) As IntPtr

    Private EditWindows As List(Of ApiWindow) = Nothing

    Public Sub New()
        ' Me.FullOpen = True
    End Sub

    <System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")> _
    Protected Overrides Function HookProc(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr

        ' Title property things"
        If Not titleSet Then
            SetWindowText(hWnd, m_title)
            titleSet = True
        End If
        ' End of title property things

        Select Case msg
            Case WM_CTLCOLOREDIT
                If IsNothing(EditWindows) Then
                    Dim mainWindow As IntPtr = GetAncestor(hWnd, GA_ROOT)
                    If Not mainWindow.Equals(IntPtr.Zero) Then
                        EditWindows = New List(Of ApiWindow)((New WindowsEnumerator).GetChildWindows(mainWindow, "Edit"))
                    End If
                End If

                If Not IsNothing(EditWindows) AndAlso EditWindows.Count = 6 Then
                    Dim strRed As String = WindowsEnumerator.WindowText(EditWindows(3).hWnd)
                    Dim strGreen As String = WindowsEnumerator.WindowText(EditWindows(4).hWnd)
                    Dim strBlue As String = WindowsEnumerator.WindowText(EditWindows(5).hWnd)

                    Dim Red, Green, Blue As Integer
                    If Integer.TryParse(strRed, Red) Then
                        If Integer.TryParse(strGreen, Green) Then
                            If Integer.TryParse(strBlue, Blue) Then
                                RaiseEvent CurrentColor(Color.FromArgb(Red, Green, Blue))
                            End If
                        End If
                    End If
                End If
        End Select

        Return MyBase.HookProc(hWnd, msg, wParam, lParam)
    End Function

End Class 

This are the other classes:

Class ApiWindow
    Public hWnd As IntPtr
    Public ClassName As String
    Public MainWindowTitle As String
End Class

Class WindowsEnumerator

Private Delegate Function EnumCallBackDelegate(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Integer

Private Declare Function EnumWindows Lib "user32" _
    (ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer

Private Declare Function EnumChildWindows Lib "user32" _
    (ByVal hWndParent As IntPtr, ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hwnd As IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer

Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As IntPtr) As Integer

Private Declare Function GetParent Lib "user32" (ByVal hwnd As IntPtr) As Integer

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As System.Text.StringBuilder) As Integer

Private _listChildren As New List(Of ApiWindow)
Private _listTopLevel As New List(Of ApiWindow)

Private _topLevelClass As String = String.Empty
Private _childClass As String = String.Empty

Public Overloads Function GetTopLevelWindows() As ApiWindow()
    EnumWindows(AddressOf EnumWindowProc, &H0)
    Return _listTopLevel.ToArray
End Function

Public Overloads Function GetTopLevelWindows(ByVal className As String) As ApiWindow()
    _topLevelClass = className
    Return Me.GetTopLevelWindows()
End Function

Public Overloads Function GetChildWindows(ByVal hwnd As Int32) As ApiWindow()
    _listChildren.Clear()
    EnumChildWindows(hwnd, AddressOf EnumChildWindowProc, &H0)
    Return _listChildren.ToArray
End Function

Public Overloads Function GetChildWindows(ByVal hwnd As Int32, ByVal childClass As String) As ApiWindow()
    _childClass = childClass
    Return Me.GetChildWindows(hwnd)
End Function

Private Function EnumWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
    If GetParent(hwnd) = 0 AndAlso IsWindowVisible(hwnd) Then
        Dim window As ApiWindow = GetWindowIdentification(hwnd)
        If _topLevelClass.Length = 0 OrElse window.ClassName.ToLower() = _topLevelClass.ToLower() Then
            _listTopLevel.Add(window)
        End If
    End If
    Return 1
End Function

Private Function EnumChildWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
    Dim window As ApiWindow = GetWindowIdentification(hwnd)
    If _childClass.Length = 0 OrElse window.ClassName.ToLower() = _childClass.ToLower() Then
        _listChildren.Add(window)
    End If
    Return 1
End Function

Private Function GetWindowIdentification(ByVal hwnd As Integer) As ApiWindow
    Dim classBuilder As New System.Text.StringBuilder(64)
    GetClassName(hwnd, classBuilder, 64)

    Dim window As New ApiWindow
    window.ClassName = classBuilder.ToString()
    window.MainWindowTitle = WindowText(hwnd)
    window.hWnd = hwnd
    Return window
End Function

Public Shared Function WindowText(ByVal hwnd As IntPtr) As String
    Const W_GETTEXT As Integer = &HD
    Const W_GETTEXTLENGTH As Integer = &HE

    Dim SB As New System.Text.StringBuilder
    Dim length As Integer = SendMessage(hwnd, W_GETTEXTLENGTH, 0, 0)
    If length > 0 Then
        SB = New System.Text.StringBuilder(length + 1)
        SendMessage(hwnd, W_GETTEXT, SB.Capacity, SB)
    End If
    Return SB.ToString
End Function

End Class

Solution

  • Example usage:

    Private Sub PicBox_Click(sender As Object, e As EventArgs) Handles PicBox.Click
        Dim prevColor As Color = PicBox.BackColor
    
        ColorDlg = New Colordialog_Realtime
        ColorDlg.Color = PicBox.backcolor
        ColorDlg.Title = "Please Select a New Color:"
        ColorDlg.Location = New Point(Me.Location.X + Me.Width, Me.Location.Y)
        If ColorDlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
            PicBox.BackColor = ColorDlg.Color
        Else
            PicBox.BackColor = prevColor
        End If
        ColorDlg = Nothing
    End Sub
    

    New Colordialog_Realtime Class:

    Public Class Colordialog_Realtime
        Inherits ColorDialog
    
        Public Event CurrentColor(ByVal c As Color)
    
        Private Const GA_ROOT As Integer = 2
        Private Const WM_PAINT As Integer = &HF
        Private Const WM_CTLCOLOREDIT As Integer = &H133
    
        Public Declare Function GetAncestor Lib "user32.dll" _
            (ByVal hWnd As IntPtr, ByVal gaFlags As Integer) As IntPtr
    
        Private EditWindows As List(Of ApiWindow) = Nothing
    
        Public Sub New()
            Me.FullOpen = True
        End Sub
    
        <Runtime.InteropServices.DllImport("user32.dll")> _
        Private Shared Function SetWindowText(hWnd As IntPtr, lpString As String) As Boolean
        End Function
    
        Private Const SWP_NOSIZE As Integer = &H1
        Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
            (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
    
        Private m_title As String = String.Empty
        Private titleSet As Boolean = False
    
        Public Property Title() As String
            Get
                Return m_title
            End Get
            Set(value As String)
                If value IsNot Nothing AndAlso value <> m_title Then
                    m_title = value
                    titleSet = False
                End If
            End Set
        End Property
    
        Private m_location As Point = Point.Empty
        Private locationSet As Boolean = False
    
        Public Property Location() As Point
            Get
                Return m_location
            End Get
            Set(value As Point)
                If Not value.Equals(Point.Empty) AndAlso Not value.Equals(m_location) Then
                    m_location = value
                    locationSet = False
                End If
            End Set
        End Property
    
        <System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")> _
        Protected Overrides Function HookProc(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
            Select Case msg
                Case WM_PAINT
                    If Not titleSet AndAlso Title <> String.Empty Then
                        SetWindowText(GetAncestor(hWnd, GA_ROOT), Title)
                        titleSet = True
                    End If
                    If Not locationSet AndAlso Not m_location.Equals(Point.Empty) Then
                        SetWindowPos(GetAncestor(hWnd, GA_ROOT), 0, m_location.X, m_location.Y, 0, 0, SWP_NOSIZE)
                        locationSet = True
                    End If
    
                Case WM_CTLCOLOREDIT
                    If IsNothing(EditWindows) Then
                        Dim mainWindow As IntPtr = GetAncestor(hWnd, GA_ROOT)
                        If Not mainWindow.Equals(IntPtr.Zero) Then
                            EditWindows = New List(Of ApiWindow)((New WindowsEnumerator).GetChildWindows(mainWindow, "Edit"))
                        End If
                    End If
    
                    If Not IsNothing(EditWindows) AndAlso EditWindows.Count = 6 Then
                        Dim strRed As String = WindowsEnumerator.WindowText(EditWindows(3).hWnd)
                        Dim strGreen As String = WindowsEnumerator.WindowText(EditWindows(4).hWnd)
                        Dim strBlue As String = WindowsEnumerator.WindowText(EditWindows(5).hWnd)
    
                        Dim Red, Green, Blue As Integer
                        If Integer.TryParse(strRed, Red) Then
                            If Integer.TryParse(strGreen, Green) Then
                                If Integer.TryParse(strBlue, Blue) Then
                                    RaiseEvent CurrentColor(Color.FromArgb(Red, Green, Blue))
                                End If
                            End If
                        End If
                    End If
            End Select
    
            Return MyBase.HookProc(hWnd, msg, wParam, lParam)
        End Function
    
    End Class