Automatic monochrome icons: make UI support official

This is now a toggle-able theme setting, just like dark/light themes or
theme accent color

Classes/pdResources.cls

@@ -15,8 +15,8 @@ Attribute VB_Exposed = False
 'PhotoDemon Resource Manager
 'Copyright 2016-2017 by Tanner Helland
 'Created: 13/December/16
-'Last updated: 29/December/16
-'Last update: add rudimentary monochrome icon support
+'Last updated: 14/February/17
+'Last update: flesh out official monochrome icon support
 '
 'PhotoDemon needs to include a whole swatch of custom resources.  These resources take up a lot of space,
 ' and we also need to pull different resources depending on things like screen DPI.  To simplify this process,
@@ -29,8 +29,6 @@ Attribute VB_Exposed = False
 
 Option Explicit
 
-Private Const DBG_TEST_MONOCHROME_ICONS As Boolean = False
-
 'If a resource file was loaded successfully, this will be set to TRUE.  You *must* check this value before
 ' attempting to retrieve individual resources.
 Private m_ResourcesAvailable As Boolean
@@ -74,8 +72,7 @@ Public Function LoadInitialResourceCollection() As Boolean
     #End If
 
     'Pull the "monochrome icon" setting from the theme engine.
-    ' TODO: actually implement this!
-    m_ThemeIconsMonochrome = DBG_TEST_MONOCHROME_ICONS
+    If (Not g_Themer Is Nothing) Then m_ThemeIconsMonochrome = g_Themer.GetMonochromeIconSetting() Else m_ThemeIconsMonochrome = False
 
     'TODO!  Someday we'll build the (finished) resource file directly into the .exe, but for now,
     ' load it from a static debug folder.
@@ -150,14 +147,15 @@ End Function
 Public Sub NotifyThemeChange()
     m_ThemeIconColor = g_Themer.GetGenericUIColor(UI_IconMonochrome)
     m_ThemeIconColorMenu = g_Themer.GetGenericUIColor(UI_IconMonochromeMenu)
+    m_ThemeIconsMonochrome = g_Themer.GetMonochromeIconSetting()
 End Sub
 
 'Load an image-type resource.  Destination width and height must be manually specified.  If they are not specified, the imgae resource
 ' will be returned as-is.  Size is not consistent nor guaranteed to be correct.
 '
 'Optional padding and colors can also be specified, for places where icons are used in non-standard ways.  (Try to keep these to a minimum,
 ' as they are not guaranteed to work nicely with all themes.)
-Public Function LoadImageResource(ByRef imgResName As String, ByRef dstDIB As pdDIB, Optional ByVal desiredWidth As Long = 0, Optional ByVal desiredHeight As Long = 0, Optional ByVal desiredBorders As Single = 0#, Optional ByVal dstIsMenu As Boolean = False, Optional ByVal customColor As Long = -1) As Boolean
+Public Function LoadImageResource(ByRef imgResName As String, ByRef dstDIB As pdDIB, Optional ByVal desiredWidth As Long = 0, Optional ByVal desiredHeight As Long = 0, Optional ByVal desiredBorders As Single = 0#, Optional ByVal dstIsMenu As Boolean = False, Optional ByVal customColor As Long = -1, Optional ByVal suspendMonochrome As Boolean = False) As Boolean
 
     LoadImageResource = False
 
@@ -274,7 +272,7 @@ Public Function LoadImageResource(ByRef imgResName As String, ByRef dstDIB As pd
                     'First: if the user wants monochrome icons, this overrides all other color settings.
                     Dim targetColor As Long
 
-                    If m_ThemeIconsMonochrome Then
+                    If m_ThemeIconsMonochrome And (Not suspendMonochrome) Then
                         If dstIsMenu Then targetColor = m_ThemeIconColorMenu Else targetColor = m_ThemeIconColor
                         DIB_Support.ColorizeDIB dstDIB, targetColor
 
@@ -328,7 +326,11 @@ Public Function LoadImageResource(ByRef imgResName As String, ByRef dstDIB As pd
 End Function
 
 Private Sub Class_Initialize()
+
     m_ResourcesAvailable = False
+    m_ThemeIconsMonochrome = False
+
     Set m_XML = New pdXML
     m_XML.SetTextCompareMode vbBinaryCompare
+
 End Sub

Classes/pdVisualThemes.cls

@@ -68,6 +68,10 @@ End Enum
 
 Private m_ThemeAccent As PD_THEME_ACCENT
 
+'When set, all requested icons will be forced to monochrome (unless specifically flagged otherwise, like the project logo;
+' see the g_Resources.LoadImageResource() function for details).
+Private m_MonochromeIcons As Boolean
+
 'Extra API functions for painting form backgrounds
 Private Const WM_PAINT As Long = &HF
 Private Const WM_ERASEBKGND As Long = &H14
@@ -158,20 +162,59 @@ Friend Function GetCurrentThemeID() As String
     GetCurrentThemeID = m_CurrentThemeID
 End Function
 
+'Get/set monochromatic icons
+Friend Function GetMonochromeIconSetting() As Boolean
+    GetMonochromeIconSetting = m_MonochromeIcons
+End Function
+
+Friend Sub SetMonochromeIconSetting(ByVal newSetting As Boolean)
+    If (newSetting <> m_MonochromeIcons) Then
+        m_MonochromeIcons = newSetting
+        g_UserPreferences.SetPref_Boolean "Themes", "MonochromeIcons", m_MonochromeIcons
+    End If
+End Sub
+
 'Pull the current default PD theme from the user preferences file, and attempt to load it.  If the theme can't be loaded,
 ' we'll fall back to PD's default light-on-dark theme.
 Friend Sub LoadDefaultPDTheme()
 
     'By default, assume a light-on-dark theme.  (This will be overridden by a successful theme load.)
     m_ThemeClass = PDTC_Dark
 
-    'Retrieve the preferred theme file from the user preferences file.  (NOTE: this step will fail inside the IDE.)
+    'Retrieve the preferred theme file from the user preferences file.  (NOTE: this step will fail inside the designer.)
     Dim themeName As String, themeFilename As String, accentName As String, accentFilename As String
     If g_IsProgramRunning Then
+
         themeName = g_UserPreferences.GetPref_String("Themes", "CurrentTheme", "Dark")
         themeFilename = "Default_" & themeName & ".xml"
+
         accentName = g_UserPreferences.GetPref_String("Themes", "CurrentAccent", "Blue")
         accentFilename = "Colors_" & accentName & ".xml"
+
+        'Note that the accent filename is not automatically mapped to an internal "accent value";
+        ' we must handle this manually.
+        If (StrComp(LCase$(accentName), "blue", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Blue
+        ElseIf (StrComp(LCase$(accentName), "brown", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Brown
+        ElseIf (StrComp(LCase$(accentName), "green", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Green
+        ElseIf (StrComp(LCase$(accentName), "orange", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Orange
+        ElseIf (StrComp(LCase$(accentName), "pink", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Pink
+        ElseIf (StrComp(LCase$(accentName), "purple", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Purple
+        ElseIf (StrComp(LCase$(accentName), "red", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Red
+        ElseIf (StrComp(LCase$(accentName), "teal", vbBinaryCompare) = 0) Then
+            m_ThemeAccent = PDTA_Teal
+        Else
+            m_ThemeAccent = PDTA_Undefined
+        End If
+
+        m_MonochromeIcons = g_UserPreferences.GetPref_Boolean("Themes", "MonochromeIcons", False)
+
     Else
         'FYI: inside the designer, PD will silently fall back on hard-coded IDE colors
     End If
@@ -198,8 +241,12 @@ Friend Sub LoadDefaultPDTheme()
             m_ThemeClass = PDTC_Dark
             themeName = "Dark"
             themeFilename = "Default_Dark.xml"
+
+            m_ThemeAccent = PDTA_Blue
             accentName = "Blue"
             accentFilename = "Colors_Blue.xml"
+
+            m_MonochromeIcons = False
             themeLoadedCorrectly = Me.LoadThemeFile(themeFilename, accentFilename)
 
             'If this attempt fails, there's nothing left to try.  Pray to the programming gods that the
@@ -314,7 +361,7 @@ Private Function DoesThemeFileExist(ByVal themeFile As String) As Boolean
 
 End Function
 
-Friend Function SetNewTheme(ByVal themeClass As PD_THEME_CLASS, Optional ByVal accentColor As PD_THEME_ACCENT = PDTA_Undefined, Optional ByVal syncMenusToMatch As Boolean = False) As Boolean
+Friend Function SetNewTheme(ByVal themeClass As PD_THEME_CLASS, Optional ByVal accentColor As PD_THEME_ACCENT = PDTA_Undefined) As Boolean
 
     Dim themeName As String
     Select Case themeClass
@@ -358,69 +405,8 @@ Friend Function SetNewTheme(ByVal themeClass As PD_THEME_CLASS, Optional ByVal a
     Else
         SetNewTheme = False
     End If
-
-    If syncMenusToMatch Then SynchronizeThemeMenus
-
-End Function
-
-'After theme changes are made, call this sub to synchronize the main window's theme menu to the current theme's properties
-Friend Sub SynchronizeThemeMenus()
-
-    If g_IsProgramRunning Then
-
-        Dim themeName As String, accentName As String
-        themeName = g_UserPreferences.GetPref_String("Themes", "CurrentTheme", "Dark")
-        accentName = g_UserPreferences.GetPref_String("Themes", "CurrentAccent", "Blue")
-
-        If (StrComp(LCase$(themeName), "dark", vbBinaryCompare) = 0) Then
-            FormMain.mnuTheme(0).Checked = True
-            FormMain.mnuTheme(1).Checked = False
-        Else
-            FormMain.mnuTheme(1).Checked = True
-            FormMain.mnuTheme(0).Checked = False
-        End If
-
-        Dim activeAccentIndex As Long
 
-        Select Case LCase$(accentName)
-
-            Case "blue"
-                activeAccentIndex = 3
-
-            Case "brown"
-                activeAccentIndex = 4
-
-            Case "green"
-                activeAccentIndex = 5
-
-            Case "orange"
-                activeAccentIndex = 6
-
-            Case "pink"
-                activeAccentIndex = 7
-
-            Case "purple"
-                activeAccentIndex = 8
-
-            Case "red"
-                activeAccentIndex = 9
-
-            Case "teal"
-                activeAccentIndex = 10
-
-            Case Else
-                activeAccentIndex = 3
-
-        End Select
-
-        Dim i As Long
-        For i = 3 To 10
-            FormMain.mnuTheme(i).Checked = CBool(i = activeAccentIndex)
-        Next i
-
-    End If
-
-End Sub
+End Function
 
 Friend Function GetCurrentThemeClass() As PD_THEME_CLASS
     GetCurrentThemeClass = m_ThemeClass
@@ -443,7 +429,7 @@ Friend Function LoadThemeFile(ByVal themeFilename As String, Optional ByVal over
 
     'Attempt to resolve the passed themeFilename to one of these locations, giving preference to the /App folder.
     ' (TODO 6.8: make a decision on how much control we expose over theme editing; maybe the /Data folder is unnecessary)
-    If g_IsProgramRunning And Not g_ProgramShuttingDown Then
+    If (g_IsProgramRunning And (Not g_ProgramShuttingDown)) Then
 
         Dim fullThemePath As String
         fullThemePath = g_UserPreferences.GetThemePath & themeFilename
@@ -541,11 +527,17 @@ Friend Function LoadThemeFile(ByVal themeFilename As String, Optional ByVal over
         'If the user's choice of theme didn't load correctly, or the default theme failed to load, run some heuristics
         ' on the theme folder.
         If LoadThemeFile Then
+
+            'Generate a unique "ID" for this theme; individual controls use this to know if they need to re-theme or not
             If (Len(overrideColorDefinitionFilename) <> 0) Then
                 m_CurrentThemeID = themeFilename & "-" & overrideColorDefinitionFilename
             Else
                 m_CurrentThemeID = themeFilename
             End If
+
+            'Add the current "monochrome icons" setting onto the theme ID, as it also forces redraws when changed
+            m_CurrentThemeID = m_CurrentThemeID & Trim$(Str$(CLng(m_MonochromeIcons)))
+
         Else
             RaiseThemingError "Default theme failed to load!  Catastrophic failure imminent!"
             ' (TODO: this entire step, including pulling themes from the .exe's resource section as necessary)
@@ -691,6 +683,8 @@ End Function
 Private Sub CacheUniversalColors()
 
     Dim colorCount As PD_UI_COLOR_LIST: colorCount = [_Count]
+
+    Set m_UniversalColors = New pdThemeColors
     m_UniversalColors.InitializeColorList "UIElements", colorCount
 
     With m_UniversalColors
@@ -767,10 +761,15 @@ Private Sub RaiseThemingError(ByVal msgError As String, Optional ByVal msgIsNonE
 End Sub
 
 Private Sub Class_Initialize()
+
     Set m_XML = New pdXML
     m_XML.SetTextCompareMode vbBinaryCompare
+
     Set m_UniversalColors = New pdThemeColors
     Set m_SubclassedHWnds = New pdDictionary
+
+    m_MonochromeIcons = False
+
 End Sub
 
 Private Sub Class_Terminate()

Controls/pdButtonStrip.ctl

@@ -83,7 +83,7 @@ Private m_ButtonHoverIndex As Long
 Private m_ButtonMouseDown As Long
 
 'Array of current button entries
-Private Type buttonEntry
+Private Type ButtonEntry
     btCaptionEn As String           'Current button caption, in its original English
     btCaptionTranslated As String   'Current button caption, translated into the active language (if English is active, this is a copy of btCaptionEn)
     btBounds As RECT                'Boundaries of this button (full clickable area, inclusive - meaning 1px border NOT included)
@@ -96,7 +96,7 @@ Private Type buttonEntry
                                     ' this value will be non-zero, and the button renderer must use it when rendering the button.
 End Type
 
-Private m_Buttons() As buttonEntry
+Private m_Buttons() As ButtonEntry
 Private m_numOfButtons As Long
 
 'Index of which button has the focus.  The user can use arrow keys to move focus between buttons.
@@ -477,7 +477,7 @@ Public Sub AddItem(ByVal srcString As String, Optional ByVal itemIndex As Long =
 
     'Increase the button count and resize the array to match
     m_numOfButtons = m_numOfButtons + 1
-    ReDim Preserve m_Buttons(0 To m_numOfButtons - 1) As buttonEntry
+    ReDim Preserve m_Buttons(0 To m_numOfButtons - 1) As ButtonEntry
 
     'Shift all buttons above this one upward, as necessary.
     If itemIndex < m_numOfButtons - 1 Then
@@ -518,12 +518,12 @@ Public Sub AddItem(ByVal srcString As String, Optional ByVal itemIndex As Long =
 End Sub
 
 'Assign a DIB to a button entry.  Disabled and hover states are automatically generated.
-Public Sub AssignImageToItem(ByVal itemIndex As Long, Optional ByVal resName As String = vbNullString, Optional ByRef srcDIB As pdDIB, Optional ByVal imgWidth As Long = 0, Optional ByVal imgHeight As Long = 0)
+Public Sub AssignImageToItem(ByVal itemIndex As Long, Optional ByVal resName As String = vbNullString, Optional ByRef srcDIB As pdDIB, Optional ByVal imgWidth As Long = 0, Optional ByVal imgHeight As Long = 0, Optional ByVal preventMonoIcons As Boolean = False)
 
     'Load the requested resource DIB, as necessary
     If (imgWidth = 0) Then imgWidth = 32
     If (imgHeight = 0) Then imgHeight = 32
-    If (Len(resName) <> 0) Then LoadResourceToDIB resName, srcDIB, imgWidth, imgHeight
+    If (Len(resName) <> 0) Then LoadResourceToDIB resName, srcDIB, imgWidth, imgHeight, , , preventMonoIcons
 
     'Cache the width and height of the DIB; it serves as our reference measurements for subsequent blt operations.
     ' (We also check for these != 0 to verify that an image was successfully loaded.)
@@ -1095,4 +1095,3 @@ End Sub
 Public Sub AssignTooltip(ByVal newTooltip As String, Optional ByVal newTooltipTitle As String, Optional ByVal newTooltipIcon As TT_ICON_TYPE = TTI_NONE)
     ucSupport.AssignTooltip UserControl.ContainerHwnd, newTooltip, newTooltipTitle, newTooltipIcon
 End Sub
-

Controls/pdButtonStripVertical.ctl

@@ -83,7 +83,7 @@ Private m_ButtonHoverIndex As Long
 Private m_ButtonMouseDown As Long
 
 'Array of current button entries
-Private Type buttonEntry
+Private Type ButtonEntry
     btCaptionEn As String           'Current button caption, in its original English
     btCaptionTranslated As String   'Current button caption, translated into the active language (if English is active, this is a copy of btCaptionEn)
     btBounds As RECT                'Boundaries of this button (full clickable area, inclusive - meaning 1px border NOT included)
@@ -100,7 +100,7 @@ Private Type buttonEntry
     btToolTipIcon As TT_ICON_TYPE   'See above comments for btToolTipText
 End Type
 
-Private m_Buttons() As buttonEntry
+Private m_Buttons() As ButtonEntry
 Private m_numOfButtons As Long
 
 'Index of which button has the focus.  The user can use arrow keys to move focus between buttons.
@@ -457,7 +457,7 @@ Public Sub AddItem(ByVal srcString As String, Optional ByVal itemIndex As Long =
 
     'Increase the button count and resize the array to match
     m_numOfButtons = m_numOfButtons + 1
-    ReDim Preserve m_Buttons(0 To m_numOfButtons - 1) As buttonEntry
+    ReDim Preserve m_Buttons(0 To m_numOfButtons - 1) As ButtonEntry
 
     'Shift all buttons above this one upward, as necessary.
     If itemIndex < m_numOfButtons - 1 Then

Controls/pdCommandBar.ctl

@@ -507,7 +507,7 @@ Private Sub cmdAction_Click(Index As Integer)
 End Sub
 
 'CANCEL button
-Private Sub cmdCancel_Click()
+Private Sub CmdCancel_Click()
 
     'The user may have Cancel actions they want to apply - let them do that
     RaiseEvent CancelClick
@@ -527,7 +527,7 @@ Private Sub cmdCancel_Click()
 End Sub
 
 'OK button
-Private Sub cmdOK_Click()
+Private Sub CmdOK_Click()
 
     'Automatically validate all relevant controls on the parent object.  This is a huge perk, because it saves us
     ' from having to write validation code individually.

Controls/pdCommandBarMini.ctl

@@ -138,7 +138,7 @@ Public Property Let Enabled(ByVal newValue As Boolean)
 End Property
 
 'CANCEL button
-Private Sub cmdCancel_Click()
+Private Sub CmdCancel_Click()
 
     'The user may have Cancel actions they want to apply - let them do that
     RaiseEvent CancelClick
@@ -161,7 +161,7 @@ Private Sub cmdCancel_Click()
 End Sub
 
 'OK button
-Private Sub cmdOK_Click()
+Private Sub CmdOK_Click()
 
     'Let the caller know that OK was pressed
     RaiseEvent OKClick