New run-time resource minimizer

I never get tired of having my own UI toolkit for PD.  It allows for so many neat tweaks and adjustments that would otherwise be a nightmare (or straight-up impossible) to implement.

Case in point: this commit!  One of the difficult things with a program like PD is that it needs to expose a *lot* of UI elements, especially on the main window.  All the graphics required for the various toolboxes (especially if a complex tool like Advanced Text is active) add up quickly, and despite aggressive optimizations, GDI object count at a cold startup is still some ~250 objects, mostly DIB handles for each control's backbuffer.

Recent changes to improve UI responsiveness - like caching toolboxes after they've been used in a session - also cause GDI object count to climb during a session.  Images with many layers, especially animated images, are also a challenge.

So in this commit, I've implemented a new strategy to help combat the potential for gradual resource climb.

First up, PD's central "pdDIB" object - the object that manages all arbitrary raster images - now provides a "Suspend" method.  This function uses a compressor of your choosing (lz4 by default) to compress the current pixel buffer to an arbitrary memory stream, after which it will free all GDI objects associated with the image.  The pixel data stays suspended until you attempt to access it (directly, or via an associated GDI handle, like a DC), at which point the class automatically recreates all necessary GDI objects and the original pixel buffer in the background.  You never need to worry about calling "unsuspend" - it always happens automatically, as needed.

Alongside this new feature, I've started adding auto-suspend calls across a swath of UI code.  When PD controls lose focus, they now suspend their backbuffer (since they're unlikely to render for awhile).  Same for when they're hidden (a tricky one to implement, since Windows doesn't provide this notification automatically - fortunately, PD has a robust system in-place for inter-window communication).

Controls that maintain internal spritesheets, like toolbox buttons, will now also free their spritesheets after a successful render event.

This imposes no noticeable change to UI fluidity, but resource improvements are significant.  On a cold start, PD has gone from ~250 GDI objects to just 148.  Cold start memory usage is also down, and even if you open every toolbox in the program during a session, PD can now suspend all UI graphics for inactive toolboxes while still maintaining the windows themselves in the background, ready at a moment's notice.  (GDI object requirements are down more than 70% in this scenario!)

I'll be adding more suspend triggers in the coming days, which should help to bring resource usage down even more.  I love the idea of each new PD release being even *more* lightweight than the previous one - despite many new features - and this commit will help 9.0 reach that goal!

(This work was actually inspired by recent animation engine work, since animation frames pose a unique challenge for resource management.  This new "suspend/resume" feature will be useful for further improving PD's resource management when working with animations, I think - I just need to do a lot of profiling first to ensure it doesn't affect animation timing accuracy.)

Author: tannerhelland

Classes/pdDIB.cls

@@ -2019,7 +2019,7 @@ End Function
 ' so for small layers, it may use a ton of dead space.  This is by design.
 '
 'Note that this specialized function cannot physically make use of the current thumbnail cache, as it
-' requires specialized transforms.  As such, its performance will possibly be (much) slower than the
+' requires specialized transforms.  As such, its performance will possibly be (much?) slower than the
 ' normal thumbnail function.
 '
 'TODO: color-management

Classes/pdLayer.cls

@@ -580,9 +580,9 @@ Friend Sub SetCustomBackcolor(Optional ByVal newBackColor As Long = -1&)
     m_BackColor = newBackColor
 End Sub
 
-'Want to receive custom window messages?  No problem.  Register them here, then watch for the CustomMessage event.
-' Note, however, that if the message is specific to PD, the caller needs to let us know, as we will need to manually
-' handle message marshaling.
+'Want to receive custom window messages?  No problem.  Register them here, then watch for
+' the CustomMessage event.  Note, however, that if the message is specific to PD, the caller
+' needs to let us know, as we will need to manually handle message marshaling.
 Friend Sub SubclassCustomMessage(ByVal wMsg As Long, Optional ByVal msgIsInternalToPD As Boolean = False)
 
     If PDMain.IsProgramRunning() Then
@@ -650,9 +650,10 @@ Private Function CacheWindowDimensions() As Boolean
 
 End Function
 
-'The naming of this function is potentially confusing, but it restores the back buffer to the currently specified back color.
-' It does not resize the DIB; it just fill it with a single uniform color.  Optionally, a specific erase rect can be supplied.
-' (If coordinates are *not* supplied, the entire buffer will be wiped.)
+'The naming of this function is potentially confusing, but it restores the back buffer to the
+' currently specified back color.  It does *not* resize the DIB; it just fills it with a single
+' uniform color.  Optionally, a specific erase rect can be supplied.  (If coordinates are *not*
+' supplied, the entire buffer will be wiped.)
 Private Sub ResetBackBuffer(Optional ByVal newBackColor As Long = -1&, Optional ByVal rpLeft As Single = 0!, Optional ByVal rpTop As Single = 0!, Optional ByVal rpWidth As Single = 0!, Optional ByVal rpHeight As Single = 0!)
 
     'If the caller specifies a background color, we want to use it.  If they don't, grab the default window background from
@@ -804,9 +805,14 @@ Private Sub m_FocusDetector_GotFocusReliable()
 End Sub
 
 Private Sub m_FocusDetector_LostFocusReliable()
+    
     m_MouseButtonState = 0
     If m_MouseInsideUC Then TriggerMouseLeave
     RaiseEvent LostFocusAPI
+    
+    'After losing focus, we typically don't expect redraws - so suspend this DIB for now
+    m_BackBuffer.SuspendDIB
+    
 End Sub
 
 Private Sub m_KeyEvents_KeyDownCustom(ByVal Shift As ShiftConstants, ByVal vkCode As Long, markEventHandled As Boolean)
@@ -999,7 +1005,7 @@ Private Sub m_WindowPainter_EraseBkgnd()
     'If backbuffering is active (as it is with most PD controls), copy the relevant portion of the buffer into place.
     Else
         GDI.BitBltWrapper targetDC, 0, 0, Me.GetControlWidth + 1, Me.GetControlHeight + 1, m_BackBuffer.GetDIBDC, 0, 0, vbSrcCopy
-        m_BackBuffer.FreeFromDC
+        m_BackBuffer.SuspendDIB
     End If
 
 End Sub
@@ -1028,7 +1034,7 @@ Private Sub m_WindowPainter_PaintWindow(ByVal winLeft As Long, ByVal winTop As L
     'If backbuffering is active (as it is with most PD controls), copy the relevant portion of the buffer into place.
     Else
         GDI.BitBltWrapper targetDC, winLeft, winTop, winWidth, winHeight, m_BackBuffer.GetDIBDC, winLeft, winTop, vbSrcCopy
-        m_BackBuffer.FreeFromDC
+        m_BackBuffer.SuspendDIB
     End If
 
 End Sub
@@ -1301,11 +1307,11 @@ Friend Sub RequestRepaint(Optional ByVal raiseImmediateDrawEvent As Boolean = Fa
     'When running, rely on the painter to paint the control for us
     If PDMain.IsProgramRunning() Then
 
-        'In the event that a paint event is not called right away (because the control is invisible, or some
-        ' other reason), free the back buffer DIB from its DC to free up a bit of resources.  If a paint
-        ' event *is* called right away, this has no ill effects, because the DC is auto-generated as needed.
+        'In the event that a paint event is not called right away (because the control is invisible,
+        ' or some other reason), free the back buffer DIB from its DC to free up a bit of resources.
+        ' If a paint event *is* called right away, this has no ill effects, because the DC is
+        ' auto-generated as needed.
         m_BackBuffer.FreeFromDC
-        
         m_WindowPainter.RequestRepaint raiseImmediateDrawEvent
 
     Else
@@ -1484,6 +1490,10 @@ Private Sub StopAllSubclassing()
 
 End Sub
 
+Private Sub HandleWM_HideChild()
+    If (Not m_NoBackBufferMode) Then m_BackBuffer.SuspendDIB
+End Sub
+
 Private Function HandleWM_WindowPosChanging(ByVal hWnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
     Dim initVisibility As Boolean
@@ -1503,8 +1513,10 @@ Private Function HandleWM_WindowPosChanging(ByVal hWnd As Long, ByVal uiMsg As L
 
     End If
 
-    'Finally, notify the parent of the pending visibility change (if any)
+    'Finally, notify the parent of the pending visibility change (if any), and suspend our
+    ' back buffer if the window has been made invisible
     If (initVisibility <> m_Visibility) Then RaiseEvent VisibilityChange(m_Visibility)
+    If (Not m_Visibility) Then m_BackBuffer.SuspendDIB
 
 End Function
 
@@ -1519,8 +1531,10 @@ Private Function HandleWM_ShowWindow(ByVal hWnd As Long, ByVal uiMsg As Long, By
     ' one before the control is actually shown.)
     If m_Visibility And (Not initVisibility) And (m_RedrawRequestCount > 0) Then AskForARepaint True, True
 
-    'Finally, notify the parent of the pending visibility change
+    'Finally, notify the parent of the pending visibility change (if any), and suspend our
+    ' back buffer if the window has been made invisible
     If (initVisibility <> m_Visibility) Then RaiseEvent VisibilityChange(m_Visibility)
+    If (Not m_Visibility) Then m_BackBuffer.SuspendDIB
 
 End Function
 
@@ -1549,9 +1563,16 @@ Private Function ISubclass_WindowMsg(ByVal hWnd As Long, ByVal uiMsg As Long, By
             m_hWnd = 0
         End If
 
+    'Child windows don't normally receive WM_SHOWWINDOW notifications.  In PD, we manually
+    ' forward these messages so that we can free up various UI-related bits to keep memory
+    ' as low as humanly possible.
+    ElseIf (uiMsg = WM_PD_HIDECHILD) Then
+        HandleWM_HideChild
+        
     Else
 
-        'See if this message is a message that our parent control wants notification for.  If it is, relay it accordingly.
+        'See if this message is a message that our parent control wants notification for.
+        ' If it is, relay it accordingly.
         If (Not m_CustomMessages Is Nothing) Then
             If m_CustomMessages.DoesKeyExist(uiMsg) Then
 

Classes/pdUCSupport.cls

@@ -73,12 +73,16 @@ Private m_ThemeAccent As PD_THEME_ACCENT
 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
-Private Declare Function GetClientRect Lib "user32" (ByVal targetHWnd As Long, ByRef lpRect As RECT) As Long
-Private Declare Function EndPaint Lib "user32" (ByVal targetHWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
+Private Const WM_PAINT As Long = &HF
+Private Const WM_SHOWWINDOW As Long = &H18
+
 Private Declare Function BeginPaint Lib "user32" (ByVal targetHWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
+Private Declare Function EndPaint Lib "user32" (ByVal targetHWnd As Long, ByRef lpPaint As PAINTSTRUCT) As Long
+Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumProc As Long, ByVal lParam As Long) As Long
+Private Declare Function GetClientRect Lib "user32" (ByVal targetHWnd As Long, ByRef lpRect As RECT) As Long
 Private Declare Function GetUpdateRect Lib "user32" (ByVal targetHWnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
+Private Declare Function SendNotifyMessage Lib "user32" Alias "SendNotifyMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
 'As part of the painting process, we're gonna be generating a looot of paint messages.  To avoid churn, we'll declare
 ' a single paint struct and update rect up front.
@@ -859,6 +863,11 @@ Friend Sub BuildThemePackage()
 
 End Sub
 
+Friend Function EnumChildProc(ByVal hWnd As Long) As Long
+    SendNotifyMessage hWnd, WM_PD_HIDECHILD, 0&, 0&
+    EnumChildProc = 1
+End Function
+
 'Helper for BuildThemePackage(), above.  Not intended or designed for any other use.
 Private Sub AddThemeFileToPackage(ByRef dstPackager As pdPackageChunky, ByRef srcFilename As String)
 
@@ -976,6 +985,23 @@ Private Function HandleFormWMEraseBkgnd(ByVal hWnd As Long, ByVal uiMsg As Long,
 
 End Function
 
+Private Function HandleFormWMShowWindow(ByVal hWnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
+    
+    'For purposes of this sub, we only care about windows getting hidden
+    If (wParam = 0) Then
+    
+        'This window is getting hidden.  Enumerate its child windows, and notify them of this event.
+        ' (By default, child windows do not receive visibility notification changes, but in PD, we use
+        ' visibility changes to suspend a bunch of UI resources.)
+        EnumChildWindows hWnd, AddressOf VBHacks.StandInEnumChildWndProc, ObjPtr(Me)
+        
+    End If
+    
+    'We don't actually handle the visibility toggle, so we need to call DefWindowProc
+    HandleFormWMShowWindow = VBHacks.DefaultSubclassProc(hWnd, uiMsg, wParam, lParam)
+    
+End Function
+
 Private Function ISubclass_WindowMsg(ByVal hWnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal dwRefData As Long) As Long
 
     If (uiMsg = WM_PAINT) Then
@@ -984,6 +1010,9 @@ Private Function ISubclass_WindowMsg(ByVal hWnd As Long, ByVal uiMsg As Long, By
     ElseIf (uiMsg = WM_ERASEBKGND) Then
         ISubclass_WindowMsg = HandleFormWMEraseBkgnd(hWnd, uiMsg, wParam, lParam)
 
+    ElseIf (uiMsg = WM_SHOWWINDOW) Then
+        ISubclass_WindowMsg = HandleFormWMShowWindow(hWnd, uiMsg, wParam, lParam)
+    
     ElseIf (uiMsg = WM_NCDESTROY) Then
 
         m_SubclassedHWnds.DeleteEntry hWnd

Classes/pdVisualThemes.cls

@@ -675,7 +675,7 @@ Private Sub RedrawBackBuffer()
             End If
 
             m_Images.AlphaBlendToDCEx bufferDC, btImageCoords.x, btImageCoords.y, m_ImageWidth, m_ImageHeight, 0, pxOffset, m_ImageWidth, m_ImageHeight
-            m_Images.FreeFromDC
+            m_Images.SuspendDIB
 
         End If
 

Controls/pdButton.ctl

@@ -1172,10 +1172,10 @@ Private Sub UpdateColorList()
         .LoadThemeColor BTS_SelectedText, "SelectedText", IDE_WHITE
         .LoadThemeColor BTS_UnselectedText, "UnselectedText", IDE_GRAY
         .LoadThemeColor BTS_Light_Background, "BackgroundLightMode", IDE_WHITE
-        .LoadThemeColor BTS_Light_SelectedItemFill, "SelectedItemFillLightMode", IDE_LIGHTBLUE
+        .LoadThemeColor BTS_Light_SelectedItemFill, "SelectedItemFillLightMode", IDE_BLUE
         .LoadThemeColor BTS_Light_UnselectedItemFill, "UnselectedItemFillLightMode", IDE_WHITE
-        .LoadThemeColor BTS_Light_SelectedItemBorder, "SelectedItemBorderLightMode", IDE_LIGHTBLUE
-        .LoadThemeColor BTS_Light_UnselectedItemBorder, "UnselectedItemBorderLightMode", IDE_LIGHTBLUE
+        .LoadThemeColor BTS_Light_SelectedItemBorder, "SelectedItemBorderLightMode", IDE_BLUE
+        .LoadThemeColor BTS_Light_UnselectedItemBorder, "UnselectedItemBorderLightMode", IDE_BLUE
         .LoadThemeColor BTS_Light_SelectedText, "SelectedTextLightMode", IDE_BLUE
         .LoadThemeColor BTS_Light_UnselectedText, "UnselectedTextLightMode", IDE_GRAY
     End With

Controls/pdButtonStrip.ctl

@@ -918,7 +918,7 @@ Private Sub RenderTrack(Optional ByVal refreshImmediately As Boolean = False, Op
                 ElseIf (m_KnobStyle = SquareStyle) Then
                     m_GradientDIB.AlphaBlendToDC m_SliderBackgroundDIB.GetDIBDC, 255, GetTrackLeft - (m_TrackDiameter \ 2) + 1, 0
                 End If
-                m_GradientDIB.FreeFromDC
+                m_GradientDIB.SuspendDIB
 
         End Select
 
@@ -1416,8 +1416,8 @@ Private Sub RedrawBackBuffer(Optional ByVal refreshImmediately As Boolean = Fals
     bufferDC = ucSupport.GetBackBufferDC(True, finalBackColor)
     If (bufferDC = 0) Then Exit Sub
 
-    'Copy the previously assembled track onto the back buffer.  (This is faster than AlphaBlending the result, especially because
-    ' we don't need any blending.)
+    'Copy the previously assembled track onto the back buffer.
+    ' (This is faster than AlphaBlending the result, and we don't need blending.)
     GDI.BitBltWrapper bufferDC, 0, 0, m_SliderAreaWidth, m_SliderAreaHeight, m_SliderBackgroundDIB.GetDIBDC, 0, 0, vbSrcCopy
     m_SliderBackgroundDIB.FreeFromDC
 

Controls/pdSliderStandalone.ctl

@@ -1325,7 +1325,7 @@ Private Sub UpdateColorList()
         .LoadThemeColor PDS_ButtonArrow, "ButtonArrow", IDE_GRAY
         .LoadThemeColor PDS_ButtonBorder, "ButtonBorder", IDE_BLUE
         .LoadThemeColor PDS_ButtonFill, "ButtonFill", IDE_WHITE
-        .LoadThemeColor PDS_ErrorBorder, "ErrorBorder", IDE_RED
+        .LoadThemeColor PDS_ErrorBorder, "ErrorBorder", IDE_GRAY
     End With
 
     RelayUpdatedColorsToEditBox

Controls/pdSpinner.ctl

@@ -136,24 +136,28 @@ End Sub
 'Want to know if a given compression engine is available?  Call this function.  It will (obviously) return FALSE for
 ' any engines that weren't initialized properly.
 Public Function IsFormatSupported(ByVal cmpFormat As PD_CompressionFormat) As Boolean
-    Select Case cmpFormat
-        Case cf_None
-            IsFormatSupported = m_CompressorAvailable(ce_None)
-        Case cf_Zlib
-            IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
-        Case cf_Zstd
-            IsFormatSupported = m_CompressorAvailable(ce_Zstd)
-        Case cf_Lz4
-            IsFormatSupported = m_CompressorAvailable(ce_Lz4)
-        Case cf_Lz4hc
-            IsFormatSupported = m_CompressorAvailable(ce_Lz4)
-        Case cf_Deflate
-            IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
-        Case cf_Gzip
-            IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
-        Case Else
-            IsFormatSupported = False
-    End Select
+    If VBHacks.IsArrayInitialized(m_CompressorAvailable) Then
+        Select Case cmpFormat
+            Case cf_None
+                IsFormatSupported = m_CompressorAvailable(ce_None)
+            Case cf_Zlib
+                IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
+            Case cf_Zstd
+                IsFormatSupported = m_CompressorAvailable(ce_Zstd)
+            Case cf_Lz4
+                IsFormatSupported = m_CompressorAvailable(ce_Lz4)
+            Case cf_Lz4hc
+                IsFormatSupported = m_CompressorAvailable(ce_Lz4)
+            Case cf_Deflate
+                IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
+            Case cf_Gzip
+                IsFormatSupported = m_CompressorAvailable(ce_LibDeflate)
+            Case Else
+                IsFormatSupported = False
+        End Select
+    Else
+        IsFormatSupported = (cmpFormat = cf_None)
+    End If
 End Function
 
 'Compress some arbitrary pointer to a destination array.

Modules/Compression.bas

@@ -383,7 +383,7 @@ End Function
 'Identical to promptGenericYesNoDialog(), above, with the caveat that only ONE possible outcome can be remembered.
 ' This is relevant for Yes/No/Cancel situations where No and Cancel prevent a workflow from proceeding.  If we allowed
 ' those values to be stored, the user could never proceed with an operation in the future!
-Public Function PromptGenericYesNoDialog_SingleOutcome(ByVal questionID As String, ByRef questionText As String, ByRef yesButtonText As String, ByRef noButtonText As String, ByRef cancelButtonText As String, ByRef rememberCheckBoxText As String, ByRef dialogTitleText As String, Optional ByVal choiceAllowedToRemember As VbMsgBoxResult = vbYes, Optional ByVal icon As SystemIconConstants = IDI_QUESTION, Optional ByVal defaultAnswer As VbMsgBoxResult = vbCancel, Optional ByVal defaultRemember As Boolean = False) As VbMsgBoxResult
+Public Function PromptGenericYesNoDialog_SingleOutcome(ByVal questionID As String, ByRef questionText As String, ByRef yesButtonText As String, ByRef noButtonText As String, ByRef cancelButtonText As String, ByRef rememberCheckBoxText As String, ByRef dialogTitleText As String, Optional ByVal choiceAllowedToRemember As VbMsgBoxResult = vbYes, Optional ByVal useIcon As SystemIconConstants = IDI_QUESTION, Optional ByVal defaultAnswer As VbMsgBoxResult = vbCancel, Optional ByVal defaultRemember As Boolean = False) As VbMsgBoxResult
 
     'Convert the questionID to its XML-safe equivalent
     Dim xmlEngine As pdXML
@@ -399,7 +399,7 @@ Public Function PromptGenericYesNoDialog_SingleOutcome(ByVal questionID As Strin
     'The user has not saved a previous answer.  Display the full dialog.
     Else
 
-        dialog_GenericMemory.ShowDialog questionText, yesButtonText, noButtonText, cancelButtonText, rememberCheckBoxText, dialogTitleText, icon, defaultAnswer, defaultRemember
+        dialog_GenericMemory.ShowDialog questionText, yesButtonText, noButtonText, cancelButtonText, rememberCheckBoxText, dialogTitleText, useIcon, defaultAnswer, defaultRemember
 
         'Retrieve the user's answer
         PromptGenericYesNoDialog_SingleOutcome = dialog_GenericMemory.DialogResult