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
#If (MsgBoxCB_FlagA And &H1000&) = 0& Then
  xCheckBoxCtlID As Long
  xRadio1 As Long
  xRadio2 As Long
  xIconResID As Long
#End If
  xEscBehaviour As Long
  xButtonCtlID As Long
  xIconCtlID As Long
  xCallBackProc As Long
  End Type
#If (MsgBoxCB_FlagA And &H1000&) = 0& Then
  Private Const MsgBoxCB_DialogInfoSize = 32&
  #Else
  Private Const MsgBoxCB_DialogInfoSize = 16&
  #End If

'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 (MsgBoxCB_FlagA And &H1000&) = 0& Then
          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
          #End If
        If Not xType1.xCallBackProc = 0& Then
          'Debug.Print Msg, wParam, lParam
          'MsgBoxCBHandler
          Call CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
          'Debug.Print Msg, wParam, lParam
          End If
        If Not xType1.xIconCtlID = 0& Then
          xType1.xIconCtlID = GetDlgItem(HWndDialog, xType1.xIconCtlID)
          If Not xType1.xIconCtlID = 0& Then
            #If (MsgBoxCB_FlagA And &H1000&) = 0& Then
              xType1.xIconResID = LoadResEx_WinIcon(xType1.xIconResID)
              If Not xType1.xIconResID = 0& Then
                'Call SendMessageA(xType1.xIconCtlID, 370&, 1&, ByVal xType1.xIconResID)
                Call SendMessageA(xType1.xIconCtlID, &H170&, 1&, ByVal xType1.xIconResID)
                End If
              #Else
              If xType1.xCallBackProc = 0& Then
                xType1.xIconCtlID = 0&
                Else
                MsgBoxCB_InternalProc = CallWindowProcA(xType1.xCallBackProc, HWndDialog, &H171&, 0&, 0&)
                If MsgBoxCB_InternalProc = 0& Then
                  xType1.xIconCtlID = 0&
                  Else
                  Call SendMessageA(xType1.xIconCtlID, &H170&, 1&, ByVal MsgBoxCB_InternalProc)
                  xType1.xIconCtlID = MsgBoxCB_InternalProc
                  End If
              #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 (MsgBoxCB_FlagA And &H1000&) = 0& Then
                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
                      xType1.xEscBehaviour = wParam
                      GoTo lblEndDialog
                      Else
                      'Debug.Print CallWindowProcA(xCallBackProc, HWndDialog, Msg, wParam, lParam)
                      If CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam) = 1& Then
                        xType1.xEscBehaviour = wParam
                        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
                #Else
                If xType1.xCallBackProc = 0& Then
                  xType1.xEscBehaviour = wParam
                  GoTo lblEndDialog
                  Else
                  'Debug.Print CallWindowProcA(xCallBackProc, HWndDialog, Msg, wParam, lParam)
                  If CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam) = 1& Then
                    xType1.xEscBehaviour = wParam
                    GoTo lblEndDialog
                    End If
                  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)
'  Stop
  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)
'        Stop
        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
