'
'
' Typically named: modDebugPrint
'
'
' This is a Stand-Alone module that can be thrown into any project.
' It works in conjunction with the PersistentDebugPrint program, and that program must be running to use this module.
' The only procedure you should worry about is the DebugPrint procedure.
' Basically, it does what it says, provides a "Debug" window that is persistent across your development IDE exits and starts (even IDE crashes).
'
' And it now has a DebugPrintTab procedure for specifying different tabs on the PersistentDebugPrint program.
'
Option Explicit
'
Private Type COPYDATASTRUCT
    dwData  As Long
    cbData  As Long
    lpData  As Long
End Type
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
'
Dim mhWndTarget As Long
'
Const DoDebugPrint As Boolean = True
'

Public Sub DebugPrintToTab(iTabNumber As Long, ParamArray vArgs() As Variant)
    ' If iTabNumber = 0, then the tab currently with focus is used.
    ' Tabs are numbered 1 thru N, and added if needed by the PersistentDebugPrint program.
    ' Any negative iTabNumber value will use the last tab in the PersistentDebugPrint program (but doesn't open a new tab).
    '
    ' Make sure we can find the PersistentDebugPrint program.
    If DoDebugPrint Then
        If Not ValidateTargetHwnd Then
            Exit Sub
        End If
    End If
    '
    ' Combine the message.
    Dim v       As Variant
    Dim sMsg    As String
    Dim bNext   As Boolean
    For Each v In vArgs
        If bNext Then
            sMsg = sMsg & Space$(8&)
            sMsg = Left$(sMsg, (Len(sMsg) \ 8&) * 8&)
        End If
        bNext = True
        sMsg = sMsg & CStr(v)
    Next
    '
    ' Print it.
    If DoDebugPrint Then
        SendStringToAnotherWindow sMsg, iTabNumber
    Else
        Debug.Print sMsg
    End If
End Sub

Public Sub DebugPrint(ParamArray vArgs() As Variant)
    ' Always uses the tab currently with focus.
    ' Commas are allowed, but not semicolons.
    '
    ' Make sure we can find the PersistentDebugPrint program.
    If DoDebugPrint Then
        If Not ValidateTargetHwnd Then
            Exit Sub
        End If
    End If
    '
    ' Combine the message.
    Dim v       As Variant
    Dim sMsg    As String
    Dim bNext   As Boolean
    For Each v In vArgs
        If bNext Then
            sMsg = sMsg & Space$(8&)
            sMsg = Left$(sMsg, (Len(sMsg) \ 8&) * 8&)
        End If
        bNext = True
        sMsg = sMsg & CStr(v)
    Next
    '
    ' Print it.
    If DoDebugPrint Then
        SendStringToAnotherWindow sMsg
    Else
        Debug.Print sMsg
    End If
End Sub

Private Function ValidateTargetHwnd() As Boolean
    If IsWindow(mhWndTarget) Then
        Select Case WindowClass(mhWndTarget)
        Case "ThunderForm", "ThunderRT6Form"
            If WindowText(mhWndTarget) = "Persistent Debug Print Window" Then
                ValidateTargetHwnd = True
                Exit Function
            End If
        End Select
    End If
    EnumWindows AddressOf EnumToFindTargetHwnd, 0&
    '
    Static bErrorMessageShown As Boolean
    If mhWndTarget = 0& Then
        If Not bErrorMessageShown Then
            MsgBox "The Persistent Debug Print Window couldn't be found.  Be sure the PersistentDebugPrint program is running.", vbCritical, "Persistent Debug Message"
            bErrorMessageShown = True
        End If
        Exit Function
    End If
    '
    ' Everything seems good.
    ValidateTargetHwnd = True
End Function

Private Function EnumToFindTargetHwnd(ByVal hWnd As Long, ByVal lParam As Long) As Long
    mhWndTarget = 0&                        ' We just set it every time to keep from needing to think about it before this is called.
    Select Case WindowClass(hWnd)
    Case "ThunderForm", "ThunderRT6Form"
        If WindowText(hWnd) = "Persistent Debug Print Window" Then
            mhWndTarget = hWnd
            Exit Function
        End If
    End Select
    EnumToFindTargetHwnd = 1&               ' Keep looking.
End Function

Private Function WindowClass(hWnd As Long) As String
    WindowClass = String$(1024&, vbNullChar)
    WindowClass = Left$(WindowClass, GetClassName(hWnd, WindowClass, 1024&))
End Function

Private Function WindowText(hWnd As Long) As String
    ' Form or control.
    WindowText = String$(GetWindowTextLength(hWnd) + 1&, vbNullChar)
    Call GetWindowText(hWnd, WindowText, Len(WindowText))
    WindowText = Left$(WindowText, InStr(WindowText, vbNullChar) - 1&)
End Function

Private Sub SendStringToAnotherWindow(sMsg As String, Optional wParam As Long)
    Dim cds             As COPYDATASTRUCT
    Dim lpdwResult      As Long
    Dim Buf()           As Byte
    Const WM_COPYDATA   As Long = &H4A&
    '
    ReDim Buf(1 To Len(sMsg) + 1&)
    Call CopyMemory(Buf(1&), ByVal sMsg, Len(sMsg)) ' Copy the string into a byte array, converting it to ANSI.
    cds.dwData = 3&
    cds.cbData = Len(sMsg) + 1&
    cds.lpData = VarPtr(Buf(1&))
    'Call SendMessage(hWndTarget, WM_COPYDATA, Me.hwnd, cds)
    SendMessageTimeout mhWndTarget, WM_COPYDATA, wParam, cds, 0&, 1000&, lpdwResult ' Return after a second even if receiver didn't acknowledge.
End Sub

