Attribute VB_Name = "mod_LoadResEx_Dialog"
' Copyright (C) 2006-2008 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA




' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0







Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Public Declare Function CheckDlgButton Lib "user32" (ByVal hDlg As Long, ByVal nIDButton As Long, ByVal wCheck As Long) As Long
'Private Declare Function CheckRadioButtonA Lib "user32" (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
Private Declare Function SetDlgItemTextA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function SetDlgItemTextW Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, lpString As Any) As Long
Private Declare Function GetDlgItemTextA Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, lpString As Any, ByVal nMaxCount As Long) As Long
Private Declare Function GetDlgItemTextW Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, lpString As Any, ByVal nMaxCount As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long







Private Const LoadResEx_Dialog_Disabled = -1&
Private Type LoadResEx_Dialog_DialogInfo
  xEscBehaviour As Long
  xButtonCtlID As Long
  xCallBackProc As Long
  End Type
Private Const LoadResEx_Dialog_DialogInfoSize = 12&


Public Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long









Private Type PROPSHEETPAGE
  Size As Long
  Flags As Long
  hInstance As Long
  pResource As Long
  hIcon As Long
  pszTitle As Long
  pfnDlgProc As Long
  lParam As Long
  pfnCallback As Long
  pcRefParent As Long
  End Type
Private Declare Function CreatePropertySheetPageA Lib "comctl32.dll" (lppsp As PROPSHEETPAGE) As Long
Private Declare Function CreatePropertySheetPageW Lib "comctl32.dll" (lppsp As PROPSHEETPAGE) As Long

Private Type PROPSHEETHEADER
  dwSize As Long
  dwFlags As Long
  hWndParent As Long
  hInstance As Long
  hIcon As Long
  pszCaption As Long 'string?
  nPages As Long
  nStartPage As Long
  'ppsp As Long
  phpage As Long
  pnfCallback As Long
  End Type
Private Declare Function PropertySheetA Lib "comctl32.dll" (lppsph As PROPSHEETHEADER) As Long
Private Declare Function PropertySheetW Lib "comctl32.dll" (lppsph As PROPSHEETHEADER) As Long







Private Function LoadResEx_Dialog_InternalProc(ByVal HWndDialog As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim xLong1 As Long
  Dim xType1 As LoadResEx_Dialog_DialogInfo
  
'Stop
  If Msg = &H110& Then
    If Not lParam = 0& Then
      xLong1 = lParam
      Call RtlMoveMemory(xType1, ByVal lParam, LoadResEx_Dialog_DialogInfoSize)
      If Not xType1.xCallBackProc = 0& Then
        If IsUnicode Then
          Call CallWindowProcWide(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
          Else
          Call CallWindowProcAnsi(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
          End If
        End If
      If Not xType1.xButtonCtlID = 0& Then
        LoadResEx_Dialog_InternalProc = GetDlgItem(HWndDialog, xType1.xButtonCtlID)
        If Not LoadResEx_Dialog_InternalProc = 0& Then
          SetFocus LoadResEx_Dialog_InternalProc
          LoadResEx_Dialog_InternalProc = 0&
          Else
          LoadResEx_Dialog_InternalProc = 1&
          End If
        End If
      Call SetWindowLong(HWndDialog, -21&, xLong1)
      End If
    Else
    xLong1 = GetWindowLong(HWndDialog, -21&)
    If Not xLong1 = 0& Then
      Call RtlMoveMemory(xType1, ByVal xLong1, LoadResEx_Dialog_DialogInfoSize)
      Select Case Msg
        Case &H10&
          If Not xType1.xEscBehaviour = LoadResEx_Dialog_Disabled Then
'            Stop
            GoTo lblEndDialog
            End If
        Case &H111& 'wm_command
          If lParam = 0& Then
            If wParam = 2& And Not xType1.xEscBehaviour = LoadResEx_Dialog_Disabled Then
'              Stop
              GoTo lblEndDialog
              End If
            Else
            If (GetWindowLong(lParam, -16&) And &HE&) = 0& Then
              If xType1.xCallBackProc = 0& Then
                xType1.xEscBehaviour = wParam
'                Stop
                GoTo lblEndDialog
                Else
                If IsUnicode Then
                  xLong1 = CallWindowProcWide(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
                  Else
                  xLong1 = CallWindowProcAnsi(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
                  End If
                If xLong1 = 1& Then
                  xType1.xEscBehaviour = wParam
'                  Stop
                  GoTo lblEndDialog
                  End If
                End If
              ElseIf Not xType1.xCallBackProc = 0& Then
              If IsUnicode Then
                Call CallWindowProcWide(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
                Else
                Call CallWindowProcAnsi(xType1.xCallBackProc, HWndDialog, Msg, wParam, lParam)
                End If
              End If
            End If
        End Select
      End If
    End If
'  Debug.Print Msg
  Exit Function

lblEndDialog:
'Stop
  If Not xType1.xCallBackProc = 0& Then
    If IsUnicode Then
      Call CallWindowProcWide(xType1.xCallBackProc, HWndDialog, &H12&, wParam, lParam)
      Else
      Call CallWindowProcAnsi(xType1.xCallBackProc, HWndDialog, &H12&, wParam, lParam)
      End If
    End If
  Call EndDialog(HWndDialog, xType1.xEscBehaviour)
  End Function

' result, or 0/1
' CheckControlID: checkboxid, or radio id (must specify RadioButtonFirst / Last!!!)
Public Function LoadResEx_Dialog(ByVal hWndOwner As Long, ByVal ResDialogOrID As Variant, Optional DefaultButtonID As Long = 0&, Optional ByVal CanEscapeControlID As Long = LoadResEx_Dialog_Disabled, Optional ByVal CallBackProc As Long, Optional ByVal hInstanceFromLanguageFile As Boolean = False) As Long
  Dim xLong1 As Long
  'Dim xChar1 As String
  Dim xType1 As LoadResEx_Dialog_DialogInfo
    
'Stop
'Exit Function
'  HackDialogResource ResDialogID, xChar1
'  Debug.Print "CallbackTo:", CallBackProc
  xType1.xCallBackProc = CallBackProc
  xType1.xEscBehaviour = CanEscapeControlID
  xType1.xButtonCtlID = DefaultButtonID
  xLong1 = LocalAlloc(0&, LoadResEx_Dialog_DialogInfoSize)
'  Debug.Print "Alloc:", xLong1
  If Not xLong1 = 0& Then
    Call RtlMoveMemory(ByVal xLong1, xType1, LoadResEx_Dialog_DialogInfoSize)
'    Debug.Print "Pre:", xLong1
'Stop
    if hInstanceFromLanguageFile and not (=0&  )then
      LoadResEx_Dialog = DialogBoxIndirectParam(ResDialogOrID, hWndOwner, AddressOf LoadResEx_Dialog_InternalProc, xLong1, App.hInstance)           ', ResDialogID)
      Else
      LoadResEx_Dialog = DialogBoxIndirectParam(ResDialogOrID, hWndOwner, AddressOf LoadResEx_Dialog_InternalProc, xLong1, App.hInstance)           ', ResDialogID)
      End If
'Stop
    Call RtlMoveMemory(xType1, ByVal xLong1, LoadResEx_Dialog_DialogInfoSize)
    Call LocalFree(xLong1)
    End If
  End Function








Public Function LoadResEx_PagedDialog(ByVal hWndOwner As Long, ByVal ResDialogID As Long, ByVal ResDialogIDLast As Long, ByVal ResDialogIDStep As Long, Optional ByVal CallBackProc As Long, Optional ByVal CaptionID As Long = -1&) ', Optional ByVal CallBackProcInit As Long)
  Dim xLong1 As Long
  Dim xMaxDialogPages As Long
  Dim xChar1 As String
  Dim xType1 As PROPSHEETHEADER
  Dim xLongA1() As Long
  Dim xLongA2() As Long
  Dim xTypeA1() As PROPSHEETPAGE

  xMaxDialogPages = (ResDialogIDLast - ResDialogID) \ ResDialogIDStep
  ReDim xLongA1(xMaxDialogPages)
  ReDim xLongA2(xMaxDialogPages)
  ReDim xTypeA1(xMaxDialogPages)
  
  xMaxDialogPages = 0&
  For xLong1 = ResDialogID To ResDialogIDLast Step ResDialogIDStep
    xChar1 = LoadResEx_Data("#" + CStr(xLong1), "#5", True)
    
    
    If Not Len(xChar1) = 0& Then
      HackDialogResource ResDialogID, xChar1
      
      xLongA1(xMaxDialogPages) = LocalAlloc(0&, Len(xChar1))
      If Not xLongA1(xMaxDialogPages) = 0& Then
        Call RtlMoveMemory(ByVal xLongA1(xMaxDialogPages), ByVal xChar1, Len(xChar1))
        With xTypeA1(xMaxDialogPages)
          .Size = Len(xTypeA1(0))
            .Flags = &H1&
          .hInstance = App.hInstance
          .pfnDlgProc = CallBackProc
          .pResource = xLongA1(xMaxDialogPages)
          
          If IsUnicode Then
            xLongA2(xMaxDialogPages) = CreatePropertySheetPageW(xTypeA1(xMaxDialogPages))
            Else
            xLongA2(xMaxDialogPages) = CreatePropertySheetPageA(xTypeA1(xMaxDialogPages))
            End If
          If xLongA2(xMaxDialogPages) = 0& Then
            Call LocalFree(xLongA1(xMaxDialogPages))
            Else
            xMaxDialogPages = xMaxDialogPages + 1&
            End If
          End With
        End If
      End If
    Next
  If Not xMaxDialogPages = 0& Then
    ReDim Preserve xTypeA1(xMaxDialogPages - 1&)
    With xType1
      .dwSize = Len(xType1)
      .nPages = xMaxDialogPages
      .hInstance = App.hInstance
      .hWndParent = hWndOwner
      .phpage = VarPtr(xLongA2(0))
      End With
    If CaptionID = -1& Then CaptionID = ResDialogID
    
    xType1.pszCaption = LocalAllocFromString(LoadResEx_String(CaptionID, False))
    If IsUnicode Then
      LoadResEx_PagedDialog = PropertySheetW(xType1)
      Else
      LoadResEx_PagedDialog = PropertySheetA(xType1)
      End If
    If Not xType1.pszCaption = 0& Then
      Call LocalFree(xType1.pszCaption)
      End If
    For xLong1 = 0& To xMaxDialogPages - 1&
      Call LocalFree(xLongA1(xLong1))
      Next
    End If
  End Function




Public Sub LoadResEx_Dialog_ListFill(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByVal ResIDFirstString As Long, ByVal ResIDLastString As Long)
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    For ResIDFirstString = ResIDFirstString To ResIDLastString
      Call SendMessageString(ControlID, &H143&, 0&, LoadResEx_String(ResIDFirstString, False))
'      Stop
      Next
    End If
  End Sub

Public Function LoadResEx_Dialog_ListIndex(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByRef Value As Long, Optional ByVal ReadFromDialog As Boolean = False) As Boolean
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    If ReadFromDialog Then
      ControlID = SendMessage(ControlID, &H188&, 0&, 0&)
      If Not ControlID = Value Then
        Value = ControlID
        LoadResEx_Dialog_ListIndex = True
        End If
      Else
      Call SendMessage(ControlID, &H186&, Value, 0&)
      End If
    End If
  End Function

Public Function LoadResEx_Dialog_ListIndexCB(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByRef Value As Long, Optional ByVal ReadFromDialog As Boolean = False) As Boolean
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    If ReadFromDialog Then
      ControlID = SendMessage(ControlID, &H147&, 0&, 0&)
      If Not ControlID = Value Then
        Value = ControlID
        LoadResEx_Dialog_ListIndexCB = True
        End If
      Else
      Call SendMessage(ControlID, &H14E&, Value, 0&)
      End If
    End If
  End Function

Public Sub LoadResEx_Dialog_ListIndexMS(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByVal Value As Long)
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    Call SendMessage(ControlID, &H185, 0&, -1&)
    Call SendMessage(ControlID, &H185, 1&, Value)
    Call SendMessage(ControlID, &H186, 1&, Value)
    'Call SendMessage(ControlID, &H14E&, Value, 0&)
    Call SendMessage(ControlID, &H14E&, Value, 0&)
    End If
  End Sub

Public Function LoadResEx_Dialog_CheckBool(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByRef Value As Boolean, Optional ByVal ReadFromDialog As Boolean = False) ', Optional ByVal Depency1ControlID As Long, Optional ByVal Depency1ControlID As Long) as boolean
  If ReadFromDialog Then
    If Not GetDlgItem(DialogHWnd, ControlID) = 0& Then
      LoadResEx_Dialog_CheckBool = CBool(IsDlgButtonChecked(DialogHWnd, ControlID))
      If LoadResEx_Dialog_CheckBool Xor Value Then
        Value = LoadResEx_Dialog_CheckBool
        LoadResEx_Dialog_CheckBool = True
        Else
        LoadResEx_Dialog_CheckBool = False
        End If
      End If
    Else
    Call CheckDlgButton(DialogHWnd, ControlID, -CLng(Value))
    End If
  End Function


'Public Sub LoadResEx_Dialog_BoolCheck(ByVal ControlID As Long, ByRef Value As Long, Optional ByVal ValueMinOrDepency1 As Long, Optional ByVal ValueMaxOrDepency2 As Long, Optional ByVal ReadFromDialog As Boolean = False)
'
'  End Sub

Public Function LoadResEx_Dialog_CheckLong(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByRef Value As Long, Optional ByVal ReadFromDialog As Boolean = False) As Boolean ', Optional ByVal ResStringIDFirst As Long = -1&) As Boolean
  Dim xLong1 As Long
  'x=(3-x) % 3
  
  xLong1 = GetDlgItem(DialogHWnd, ControlID)
  If Not xLong1 = 0& Then
    xLong1 = (GetWindowLong(xLong1, -16&) And &HF&)
    If ReadFromDialog Then
      If Not GetDlgItem(DialogHWnd, ControlID) = 0& Then
        ControlID = IsDlgButtonChecked(DialogHWnd, ControlID)
        If xLong1 = &H5& Then ControlID = ((3& - ControlID) Mod 3&)
        If Not ControlID = Value Then
          Value = ControlID
          LoadResEx_Dialog_CheckLong = True
          End If
        End If
      Else
      'If ResStringIDFirst = -1& Then ResStringIDFirst = ControlID
      Call SetDlgItemText(DialogHWnd, ControlID, LoadResEx_String(ControlID + Value, True))
      If xLong1 = &H5& Then xLong1 = ((3& - Value) Mod 3&)
      Call CheckDlgButton(DialogHWnd, ControlID, xLong1)
      'Call SetDlgItemTextA(DialogHWnd, ControlID, LoadResEx_String(ResStringIDFirst + Value, True))
      End If
    End If
  End Function

Public Sub LoadResEx_Dialog_Enable(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByVal Enable As Boolean)
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    Call EnableWindow(ControlID, -CLng(Enable))
    End If
  End Sub

Public Function LoadResEx_Dialog_SpinnerLong(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByRef Value As Long, Optional ByVal ReadFromDialog As Boolean = False, Optional ByVal Min As Long = -1&, Optional ByVal Max As Long = -1&) As Boolean
  'Const WM_USER = &H400
  'Private Const UDM_GETPOS As Long = (WM_USER + 104) '468
  'Private Const UDM_SETPOS As Long = (WM_USER + 103) '467
  'Private Const UDM_SETRANGE As Long = (WM_USER + 101) '465
  
  ControlID = GetDlgItem(DialogHWnd, ControlID)
  If Not ControlID = 0& Then
    If ReadFromDialog Then
      ControlID = SendMessage(ControlID, &H468&, 0&, 0&)
      If Not ControlID = Value Then
        Value = ControlID
        LoadResEx_Dialog_SpinnerLong = True
        End If
      Else
      If Not (Max = -1& Or Min = -1&) Then
        Call SendMessage(ControlID, &H465&, 0&, (Min * &H10000 + Max))
        Call SendMessage(ControlID, &H467&, 0&, Value)
        End If
      End If
    End If
  End Function

Public Function LoadResEx_Dialog_CheckLong_Handler(ByVal DialogHWnd As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim xLong1 As Long
  'x = (x + 2) % 3 for direct
  xLong1 = (wParam And &HFFFF&)
  LoadResEx_Dialog_CheckLong_Handler = -1&
  
  If Not lParam = 0& Then
    If (GetWindowLong(lParam, -16&) And &HF&) = &H5& Then
      wParam = (IsDlgButtonChecked(DialogHWnd, xLong1) + 2&) Mod 3&
      Call CheckDlgButton(DialogHWnd, xLong1, wParam)
      LoadResEx_Dialog_CheckLong_Handler = (3& - wParam) Mod 3&
      Call SetDlgItemText(DialogHWnd, xLong1, LoadResEx_String(xLong1 + LoadResEx_Dialog_CheckLong_Handler, True))
      End If
    End If
  End Function

Public Sub SetDlgItemText(ByVal DialogHWnd As Long, ByVal ControlID As Long, ByVal Text As String)
  If IsUnicode Then
    Call SetDlgItemTextW(DialogHWnd, ControlID, ByVal StrPtr(Text))
    Else
    Call SetDlgItemTextA(DialogHWnd, ControlID, Text)
    End If
  End Sub

Public Function GetDlgItemText(ByVal hDlg As Long, ByVal nIDDlgItem As Long) As String
  If IsUnicode Then
    hDlg = GetDlgItemTextW(hDlg, nIDDlgItem, ByVal ptrTemp, ptrTempSizeXW)
    Else
    hDlg = GetDlgItemTextA(hDlg, nIDDlgItem, ByVal ptrTemp, ptrTempSizeX)
    End If
  GetDlgItemText = PeekS(ptrTemp, hDlg)
  End Function


