Attribute VB_Name = "hlp_MsgBoxCB"
Option Explicit
Option Base 0

' Should be threadsafe?
' radios untested!


Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const MsgBoxCB_Disabled = -1&
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Type MsgBoxCB_DialogInfo
  xCheckBoxCtlID As Long
  xEscBehaviour As Long
  xButtonCtlID As Long
  xIconCtlID As Long
  xIconResID As Long
  xRadio1 As Long
  xRadio2 As Long
  xCallBackProc As Long
  End Type
Private Const MsgBoxCB_DialogInfoSize = 32&

'Private Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function DialogBoxIndirectParamA Lib "user32" (ByVal hInstance As Long, hDialogTemplate As Any, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal xParam As Long) As Long
'Private Declare Function CreateDialogIndirectParamA Lib "user32" (ByVal hInstance As Long, lpTemplate As Any, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal xParam As Long) As Long
Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Public Declare Function CheckDlgButton Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long, ByVal wCheck As Long) As Long
Public Declare Function CheckRadioButton Lib "user32" Alias "CheckRadioButtonA" (ByVal hDlg As Long, ByVal nIDFirstButton As Long, ByVal nIDLastButton As Long, ByVal nIDCheckButton As Long) As Long
Public Declare Function IsDlgButtonChecked Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long) As Long
Public Declare Function SetDlgItemTextA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Public Declare Function GetDlgItemTextA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Public Function MsgBoxCB_InternalProc(ByVal HWndDialog As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xType1 As MsgBoxCB_DialogInfo
  
  If Msg = &H110& Then
    If Not lParam = 0& Then
      xLong1 = lParam
      xLong2 = LocalLock(xLong1)
      If Not xLong2 = 0& Then
        'Debug.Print "init", lParam, wParam
        Call RtlMoveMemory(xType1, ByVal xLong2, MsgBoxCB_DialogInfoSize)
        
        If xType1.xRadio1 = 0& Then
          If xType1.xCheckBoxCtlID < 0& Then
            xType1.xCheckBoxCtlID = -xType1.xCheckBoxCtlID
            MsgBoxCB_InternalProc = 1&
            ElseIf Not xType1.xCheckBoxCtlID = 0& Then
            MsgBoxCB_InternalProc = 0&
            End If
          Call CheckDlgButton(HWndDialog, xType1.xCheckBoxCtlID, MsgBoxCB_InternalProc)
          ElseIf wParam >= xType1.xRadio1 And wParam <= xType1.xRadio2 Then
          Call CheckRadioButton(HWndDialog, xType1.xRadio1, xType1.xRadio2, wParam)
          End If
        If Not xType1.xCallBackProc = 0& Then
          Call CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
          End If
        If Not xType1.xIconCtlID = 0& Then
          xType1.xIconCtlID = GetDlgItem(HWndDialog, xType1.xIconCtlID)
          If Not xType1.xIconCtlID = 0& Then
            xType1.xIconResID = LoadResEx_WinIcon(xType1.xIconResID)
            If Not xType1.xIconResID = 0& Then
              Call SendMessageA(xType1.xIconCtlID, 370&, 1&, ByVal xType1.xIconResID)
              End If
            End If
          End If
        
        MsgBoxCB_InternalProc = 1&
        
        'xLong1 = LocalAlloc(0&, MsgBoxCB_DialogInfoSize)
        'If Not xLong1 = 0& Then
        '  xLong2 = LocalLock(xLong1)
        '  If xLong2 = 0& Then
        '    Call LocalFree(xLong1)
        '    Else
        '    Call RtlMoveMemory(ByVal xLong2, xType1, MsgBoxCB_DialogInfoSize)
        '    LocalUnlock (xLong1)
        '    End If
        '  End If
        'Call SetWindowLongA(HWndDialog, -21&, xLong1)
        Call LocalUnlock(xLong1)
        End If
      'Call LocalUnlock(xLong1)
      Call SetWindowLongA(HWndDialog, -21&, xLong1)
      End If
    Else
    xLong1 = GetWindowLongA(HWndDialog, -21&)
    If Not xLong1 = 0& Then
      xLong2 = LocalLock(xLong1)
      If Not xLong2 = 0& Then
        Call RtlMoveMemory(xType1, ByVal xLong2, MsgBoxCB_DialogInfoSize)
        Select Case Msg
          Case &H10&
            If Not xType1.xEscBehaviour = MsgBoxCB_Disabled Then
              GoTo lblEndDialog
              End If
          Case &H111& 'wm_command
            If lParam = 0& Then
              If wParam = 2& And Not xType1.xEscBehaviour = MsgBoxCB_Disabled Then
                GoTo lblEndDialog
                End If
              Else
              If (GetWindowLongA(lParam, -16&) And &HE&) = 0& Then
                If Not (wParam = 0& And xType1.xEscBehaviour = MsgBoxCB_Disabled) Then
                  If Not xType1.xCheckBoxCtlID = 0& Then
                    If xType1.xRadio1 = 0& Then
                      xType1.xCheckBoxCtlID = IsDlgButtonChecked(HWndDialog, xType1.xCheckBoxCtlID)
                      Else
                      xType1.xCheckBoxCtlID = 0&
                      For lParam = xType1.xRadio1 To xType1.xRadio2
                        If Not IsDlgButtonChecked(HWndDialog, lParam) = 0& Then
                          xType1.xCheckBoxCtlID = xType1.xRadio1
                          Exit For
                          End If
                        Next
                      End If
                    End If
                  If xType1.xCallBackProc = 0& Then
                    GoTo lblEndDialog
                    Else
                    'Debug.Print CallWindowProcA(xCallBackProc, HWndDialog, Msg, wParam, lParam)
                    If CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam) = 1& Then
                      GoTo lblEndDialog
                      End If
                    End If
                  End If
                Else
                'checkbox or option
                If (GetWindowLongA(lParam, -16&) And &HC&) = 0& Then
                  If IsDlgButtonChecked(HWndDialog, wParam) = 0& Then
                    lParam = 1&
                    Else
                    lParam = 0&
                    End If
                  Call CheckDlgButton(HWndDialog, xType1.xCheckBoxCtlID, lParam)
                  ElseIf wParam >= xType1.xRadio1 And wParam <= xType1.xRadio2 Then
                  Call CheckRadioButton(HWndDialog, xType1.xRadio1, xType1.xRadio2, wParam)
                  End If
                End If
              End If
          End Select
      '  Debug.Print "DLG:", Hex(Msg), wParam, lParam
        End If
      Call LocalUnlock(xLong1)
      End If
    End If
  Exit Function

lblEndDialog:
  If Not (xType1.xIconCtlID = 0& Or xType1.xIconResID = 0&) Then
    Call DestroyIcon(xType1.xIconResID)
    End If
  Call LocalUnlock(xLong1)
  Call EndDialog(HWndDialog, xType1.xEscBehaviour)
  End Function

' result, or 0/1
' CheckControlID: checkboxid, or radio id (must specify RadioButtonFirst / Last!!!)
'
Public Function MsgBoxCB(ByVal HwndOwner As Long, ByVal ResDialogID As Long, Optional ByRef CheckControlID As Long = 0&, Optional DefaultButtonID As Long = 0&, Optional ByVal CanEscapeControlID As Long = MsgBoxCB_Disabled, Optional ByVal IconControlID As Long, Optional ByVal IconResID As Long, Optional ByVal RadioButtonFirstID As Long, Optional ByVal RadioButtonLastID As Long, Optional ByVal CallBackProc As Long) As Long
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xChar1 As String
  Dim xType1 As MsgBoxCB_DialogInfo
  
  xChar1 = LoadResEx_Data("#" + CStr(ResDialogID), "#5", True)
  If Not Len(xChar1) = 0& Then
    xType1.xCallBackProc = CallBackProc
    xType1.xEscBehaviour = CanEscapeControlID
    xType1.xCheckBoxCtlID = CheckControlID
    xType1.xButtonCtlID = DefaultButtonID
    xType1.xIconCtlID = IconControlID
    xType1.xIconResID = IconResID
    xType1.xRadio1 = RadioButtonFirstID
    xType1.xRadio2 = RadioButtonLastID
    If RadioButtonLastID = 0& And Not RadioButtonFirstID = 0& Then xType1.xRadio2 = RadioButtonFirstID
    xLong1 = LocalAlloc(0&, MsgBoxCB_DialogInfoSize)
    If Not xLong1 = 0& Then
      xLong2 = LocalLock(xLong1)
      If xLong2 = 0& Then
        Call LocalFree(xLong1)
        Else
        Call RtlMoveMemory(ByVal xLong2, xType1, MsgBoxCB_DialogInfoSize)
        Call LocalUnlock(xLong1)
        MsgBoxCB = DialogBoxIndirectParamA(App.hInstance, ByVal xChar1, HwndOwner, AddressOf MsgBoxCB_InternalProc, xLong1)  ', ResDialogID)
        xLong2 = LocalLock(xLong1)
        If Not xLong2 = 0& Then
          Call RtlMoveMemory(xType1, ByVal xLong2, MsgBoxCB_DialogInfoSize)
          CheckControlID = xType1.xCheckBoxCtlID
          Call LocalUnlock(xLong1)
          End If
        End If
      Call LocalFree(xLong1)
      End If
    
    
    
    
    'If Not MsgBoxCB = 0& Then
    '  Call SetWindowPos(MsgBoxCB, 0&, 0&, 0&, 0&, 0&, &H243&)
    '  End If
    End If
  End Function

'Public Function MsgBoxCBHandler(ByVal HWndDialog As Long, ByVal Msg As Long, ByVal ControlID As Long, ByVal ControlHWnd As Long) As Long
'  MsgBoxCBHandler = 1&
'  End Function
