Attribute VB_Name = "hlp_MsgBoxCB"
Option Explicit
Option Base 0

' Should be threadsafe?
' radios untested!

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
  xEscBehaviour As Long
  xButtonCtlID As Long
  xCallBackProc As Long
  End Type
Private Const MsgBoxCB_DialogInfoSize = 12&

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
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
        Call RtlMoveMemory(xType1, ByVal xLong2, MsgBoxCB_DialogInfoSize)
        If Not xType1.xCallBackProc = 0& Then
          Call CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
          End If
        MsgBoxCB_InternalProc = 1&
        Call LocalUnlock(xLong1)
        End If
      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 xType1.xCallBackProc = 0& Then
                  xType1.xEscBehaviour = wParam
                  GoTo lblEndDialog
                  Else
                  If CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam) = 1& Then
                    xType1.xEscBehaviour = wParam
                    GoTo lblEndDialog
                    End If
                  End If
                ElseIf Not xType1.xCallBackProc = 0& Then
                Call CallWindowProcA(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
                End If
              End If
          End Select
        End If
      Call LocalUnlock(xLong1)
      End If
    End If
  Exit Function

lblEndDialog:
  If Not xType1.xCallBackProc = 0& Then
    Call CallWindowProcA(xType1.xCallBackProc, HWndDialog, &H12&, wParam, lParam)
    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 DefaultButtonID As Long = 0&, Optional ByVal CanEscapeControlID As Long = MsgBoxCB_Disabled, Optional ByVal CallBackProc As Long) As Long
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xChar1 As String
  Dim xType1 As MsgBoxCB_DialogInfo
  
  'Stop
  xChar1 = LoadResEx_Data("#" + CStr(ResDialogID), "#5", True)
'  Stop
  If Not Len(xChar1) = 0& Then
    xType1.xCallBackProc = CallBackProc
    xType1.xEscBehaviour = CanEscapeControlID
    #If (MsgBoxCB_FlagA And &H1000&) = 0& Then
      xType1.xCheckBoxCtlID = CheckControlID
      #End If
    
    xType1.xButtonCtlID = DefaultButtonID
    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)
          #If (MsgBoxCB_FlagA And &H1000&) = 0& Then
            CheckControlID = xType1.xCheckBoxCtlID
            #End If
          Call LocalUnlock(xLong1)
          End If
        End If
      Call LocalFree(xLong1)
      End If
    End If
  End Function
