!=======================================================================
!                   _____________________________
!               \\//-----------------------------
!                )(   //=  //= //= //// //)) //
!               //\\ //_  //  //  /__/ //\\ //
!=======================================================================
!                       XEFFORT LIBRARY
!=======================================================================
! XFTDialog.f90 - dialog functions
!
! 2005. Xeffort.com
!  Jugoslav Dujic (jdujic@uns.ns.ac.yu)
!
! You are free to use the code for both commercial and non-commercial
! use. The code is provided as-is without warranties. You are free to
! distribute and modify this source code provided that the list of
! original author(s) remains untouched and your revisions are indicated
! as such. Contributions are welcome.
!=======================================================================

MODULE XFTDialog

USE XFTTYPES
USE XFTAPI
USE XFTWND
USE XFTCTRL

IMPLICIT NONE

PRIVATE

PUBLIC XLoadDialog            !(ID, xDlg, [xOwner], [hModule])
PUBLIC XModalDialog           !(xDlg, [hParent])
PUBLIC XModelessDialog        !(xDlg, [nCmdShow])
PUBLIC XEndDialog             !(xDlg, ID)
PUBLIC XDestroyDialog         !(xDlg)
PUBLIC XMessageBox            !(sText, [sCaption], [iFlags], [xWnd], [idIcon], [sRegKey], [sRegValue], [sUserButton])

PRIVATE PXPutControl          !(iDt, iPos, iStyle, iExtendedStyle, &
                              !x, y, cx, cy, id, iType, [sTitle], [idIcon])
PRIVATE PXPutChar             !(iDt, iPos, s)
PRIVATE PXPutInt2             !(iDt, iPos, i2)
PRIVATE PXPutInt4             !(iDt, iPos, i4)
PRIVATE PXMBEnableProc        !(hWnd, hDialog)
PRIVATE PXEnableProc          !(hWnd, hDialog)
PRIVATE PXDisableProc         !(hWnd, hDialog)
PRIVATE PXParseDlgInit        !(hModule, hDialog, idDialog)

INTEGER, PARAMETER:: IDC_CHECK = 1001


!======================================================================
CONTAINS
!======================================================================
!Loads the dialog xDlg with ID from optional library hModule (the default
!is "this" exe) with owner xOwner (default is XW_FRAME or desktop)
LOGICAL FUNCTION XLoadDialog(ID, xDlg, xOwner, hModule)

INTEGER, INTENT(IN)::               ID
TYPE(X_WINDOW)::                    xDlg
TYPE(X_WINDOW), OPTIONAL, INTENT(IN)::     xOwner
INTEGER, OPTIONAL, INTENT(IN)::     hModule

INTEGER::                           hInst, hParent, iSt, iErr

xDlg%hWnd = 0
xDlg%nMsg = 0
xDlg%nCtl = 0
xDlg%nCommands = 0
xDlg%nActions = 0
xDlg%lpWindowProc = XPROC_DIALOG
xDlg%ID = ID
DEALLOCATE(xDlg%xCtl, STAT=iErr)
NULLIFY(xDlg%xCtl)
CALL InitCommonControls()
IF (PRESENT(hModule)) THEN
      hInst = hModule
ELSE
      hInst = GetModuleHandle(0)
END IF
IF (PRESENT(xOwner)) THEN
      hParent = xOwner%hWnd
ELSE IF (ASSOCIATED(xgApp%xFrame)) THEN
      IF (IsWindow(xgApp%xFrame%hWnd)) THEN
            hParent = xgApp%xFrame%hWnd
      ELSE
            hParent = GetDesktopWindow()
      END IF
ELSE
      hParent = GetDesktopWindow()
END IF

xDlg%hWnd = CreateDialogParam(hInst, ID, hParent, LOC(FXWindowProc), LOC(xDlg))

iSt=GetLastError()

XLoadDialog = xDlg%hWnd .NE. 0
IF (XLoadDialog) THEN
      CALL FXBindWindowControls(xDlg)
      CALL PXParseDlgInit(hInst, xDlg%hWnd, ID)
!      iSt = SetProp(xDlg%hWnd, "XWND"C, LOC(xDlg))
      CALL FXAssocCtlToHandle(xDlg%hWnd, xDlg%xCtl(0))
      xDlg%xCtl(0)%hWnd = xDlg%hWnd
      xDlg%xCtl(0)%iType = XCTL_DIALOG
      xDlg%xCtl(0)%iStyle = GetWindowLong(xDlg%hWnd, GWL_STYLE)
      xDlg%xCtl(0)%hParent = hParent
      xDlg%xCtl(0)%lpCallback = 0
      xDlg%xCtl(0)%iBkColor = -1
      xDlg%xCtl(0)%iColor = -1
      IF (IAND(GetWindowLong(xDlg%hWnd, GWL_STYLE),WS_CHILD) .NE. 0) THEN
            iSt = SetWindowLong(xDlg%hWnd, GWL_ID, ID)
      END IF
END IF

END FUNCTION XLoadDialog
!======================================================================
!XModalDialog displays the modal dialog xDlg, which must be loaded
!using XLoadDialog. hParent argument is optional & undocumented; should be
!used only from XFLOGM 2.0 layer.
RECURSIVE INTEGER FUNCTION XModalDialog(xDlg, hParent, bAppModal)

TYPE(X_WINDOW)::           xDlg
INTEGER, OPTIONAL, INTENT(IN):: hParent
LOGICAL, OPTIONAL, INTENT(IN):: bAppModal

INTEGER::                  iSt, hActive, iStyle, hlParent, iExitCode
LOGICAL::                  blAppModal, bQuitting
TYPE(T_MSG)::              Mesg
TYPE(X_CONTROL)::          xCtl; POINTER(pxCtl, xCtl)

XModalDialog = -1
IF (.NOT.XIsWindow(xDlg,XFT_WINDOW)) RETURN

iSt = ShowWindow(xDlg%hWnd, SW_SHOW)

blAppModal = .FALSE.
IF (PRESENT(bAppModal)) blAppModal = bAppModal
hlParent = GetParent(xDlg%hWnd)
IF (PRESENT(hParent)) THEN
      IF (IsWindow(hParent)) THEN
            hlParent = hParent
            iSt = SetParent(xDlg%hWnd, hlParent)
      END IF
END IF

IF (blAppModal) THEN
      iSt = EnumThreadWindows(GetCurrentThreadID(), LOC(PXDisableProc), xDlg%hWnd)
ELSE
      iSt = EnableWindow(hlParent, .FALSE.)
END IF

iSt = ShowWindow(xDlg%hWnd, SW_SHOW)
iSt = SetActiveWindow(xDlg%hWnd)

pxCtl = FXCtlByHandle(xDlg%hWnd)
IF (pxCtl.NE.0) THEN
      iSt = FXCtlCallback(xDlg, xCtl, xDlg%ID, WM_INITDIALOG)
END IF

!Check whether WM_QUIT *was* in the message queue and store it if so
bQuitting = PeekMessage(Mesg, 0, WM_QUIT, WM_QUIT, PM_REMOVE).NE.0
IF (bQuitting) iExitCode = Mesg%wParam

DO WHILE( GetMessage(Mesg,NIL,0,0) .NEQV. .FALSE.)
      IF (Mesg%message.EQ.WM_EXITDLG) THEN
            IF (Mesg%lParam.EQ.xDlg%hWnd) THEN
                  XModalDialog = Mesg%wParam
                  EXIT
            END IF
      ELSE
            hActive=GetActiveWindow()
            iStyle=GetWindowLong(hActive,GWL_EXSTYLE)
            IF (IAND(iStyle,WS_EX_CONTROLPARENT).NE.0) THEN
                  IF (.NOT.IsDialogMessage(xDlg%hWnd,Mesg)) THEN
                        iSt=TranslateMessage(Mesg)
                        iSt=DispatchMessage(Mesg)
                  END IF
            ELSE
                  iSt=TranslateMessage(Mesg)
                  iSt=DispatchMessage(Mesg)
            END IF
      END IF
END DO

!If someone else calls PostQuitMessage, this should be propagated
!all the way down to main message queue for purpose of exiting
!the application.
IF (Mesg%message.EQ.WM_QUIT) CALL PostQuitMessage(Mesg%wParam)
!Repost WM_QUIT if existed
IF (bQuitting) CALL PostQuitMessage(iExitCode)

IF (blAppModal) THEN
      iSt = EnumThreadWindows(GetCurrentThreadID(), LOC(PXEnableProc), xDlg%hWnd)
      iSt = ShowWindow(xDlg%hWnd, SW_HIDE)
      iSt = SetActiveWindow(hlParent)
ELSE
      iSt = EnableWindow(hlParent, .TRUE.)
      iSt = ShowWindow(xDlg%hWnd, SW_HIDE)
      iSt = SetActiveWindow(hlParent)
END IF

END FUNCTION XModalDialog
!======================================================================
!XModelessDialog displays the modeless dialog xDlg, which must be loaded
!using XLoadDialog. nCmdShow argument is optional & undocumented;
!should be used only from XFLOGM 2.0 layer. With XFLOGM 2.0, hParent
!is set in the calling DlgModeless.
RECURSIVE LOGICAL FUNCTION XModelessDialog(xDlg, nCmdShow)

TYPE(X_WINDOW)::           xDlg
INTEGER, OPTIONAL, INTENT(IN):: nCmdShow

INTEGER::                  ID, iSt
TYPE(T_MSG)::              Mesg
TYPE(X_CONTROL)::          xCtl; POINTER(pxCtl, xCtl)

XModelessDialog = .FALSE.
IF (.NOT.XIsWindow(xDlg,XFT_WINDOW)) RETURN

IF (PRESENT(nCmdShow)) THEN
      iSt = ShowWindow(xDlg%hWnd, nCmdShow)
ELSE
      iSt = ShowWindow(xDlg%hWnd, SW_SHOW)
END IF

pxCtl = FXCtlByHandle(xDlg%hWnd)
IF (pxCtl.NE.0) THEN
      iSt = FXCtlCallback(xDlg, xCtl, xDlg%ID, WM_INITDIALOG)
END IF
XModelessDialog = .TRUE.

END FUNCTION XModelessDialog
!======================================================================
!Ends (more precisely, hides) the modal dialog xDlg, which will return ID.
SUBROUTINE XEndDialog(xDlg,ID)

TYPE(X_WINDOW)::                 xDlg
INTEGER::                        ID

INTEGER::                  iSt

iSt = PostMessage(xDlg%hWnd, WM_EXITDLG, ID, xDlg%hWnd)

END SUBROUTINE XEndDialog

!======================================================================
!Physically destroys the dialog xDlg. Corresponds to XFLOGM DlgUnInit.
SUBROUTINE XDestroyDialog(xDlg)

TYPE(X_WINDOW)::  xDlg

INTEGER::         iSt

CALL XCtlDestroyAll(xDlg, .FALSE.)
iSt = DestroyWindow(xDlg%hWnd)
xDlg%hWnd = 0

END SUBROUTINE XDestroyDialog

!======================================================================
!XMessageBox displays a message box
INTEGER FUNCTION XMessageBox(sText, sCaption, iFlags, xWnd, idIcon, sRegKey, sRegValue, hModule, sUserButton)

USE XFTREG

CHARACTER(*), INTENT(IN)::                sText
CHARACTER(*), OPTIONAL, INTENT(IN)::      sCaption
INTEGER, OPTIONAL, INTENT(IN)::           iFlags
TYPE(X_WINDOW), OPTIONAL, INTENT(IN)::    xWnd
INTEGER, OPTIONAL, INTENT(IN)::           idIcon
CHARACTER(*), OPTIONAL, INTENT(IN)::      sRegValue
CHARACTER(*), OPTIONAL, INTENT(IN)::      sRegKey
INTEGER, OPTIONAL, INTENT(IN)::           hModule
CHARACTER(*), OPTIONAL, INTENT(IN)::      sUserButton(:)


INTEGER(2)::               iDt(0:*); POINTER(lpDt, iDt)
INTEGER(2)::               i2
INTEGER(2)::               wBtnText(*); POINTER(pwBtnText, wBtnText)
INTEGER::                  iSize, iPos, iSt, jPos, iWidth, iHeight, iStaticHeight, nButtons,          &
                           hUser32, nIcons, jFlags, jdIcon, hInst, iStyle, iDefButton,  &
                           i, hWnd, hKey, iAnswer, nCheck, hDC, iDBY, iDBX, iStaticStyle, iExitCode
INTEGER::                  iTryWd, iCstep, lenText, iTxtDWD, iTxtDHT
INTEGER::                  orgFont
CHARACTER(20)::            sBtnText
INTEGER::                  idButton(5), idsButton(5)
TYPE(T_RECT)::             Rect
TYPE(T_MSG)::              Msg
LOGICAL::                  bQuitting

TYPE(T_DLGTEMPLATE)::     DT
TYPE(T_DLGITEMTEMPLATE):: DIT
TYPE(T_LOGFONT)::         LF

INTEGER, PARAMETER:: DIT_BUTTON    =Z'0080'
INTEGER, PARAMETER:: DIT_EDIT      =Z'0081'
INTEGER, PARAMETER:: DIT_STATIC    =Z'0082'
INTEGER, PARAMETER:: DIT_LISTBOX   =Z'0083'
INTEGER, PARAMETER:: DIT_SCROLLBAR =Z'0084'
INTEGER, PARAMETER:: DIT_COMBOBOX  =Z'0085'

INTEGER, PARAMETER:: BTN_WIDTH   = 50
INTEGER, PARAMETER:: BTN_HEIGHT  = 14
INTEGER, PARAMETER:: BTN_SPACING = 70
INTEGER, PARAMETER:: CHECK_HEIGHT = 10
INTEGER, PARAMETER:: DT_FIT = DT_CALCRECT.OR.DT_TOP.OR.DT_LEFT   &
        & .OR.DT_WORDBREAK.OR.DT_NOPREFIX.OR.DT_NOCLIP        !! no longer .OR.DT_INTERNAL

CHARACTER(7), PARAMETER::  sDefBtnText(IDOK:IDHELP) = &
   (/"OK     ", "Cancel ", "&Abort ", "&Retry ", "&Ignore", "&Yes   ", "&No    ", "Close  ", "&Help  "/)

!           external function
INTEGER XMessageFontHndl

!Undocumented routine on NT systems which returns
!localized button strings
INTERFACE
   INTEGER FUNCTION MB_GetString(ID)
   !DEC$ATTRIBUTES STDCALL:: MB_GetString
   INTEGER:: ID
   END FUNCTION MB_GetString
END INTERFACE
POINTER(lpMBGetString, MB_GetString)

!If the reg key with negative value exists, return the default answer
XMessageBox = 0
nCheck = 0
IF (PRESENT(sRegKey).AND.PRESENT(sRegValue)) THEN
      hKey = XRegOpen(HKEY_CURRENT_USER, sRegKey, KEY_QUERY_VALUE.OR.KEY_SET_VALUE, XREG_OLD)
      IF (hKey.EQ.0) RETURN
      iSt = XRegRead(hKey, sRegValue, iAnswer)
      IF (iSt.EQ.0 .AND. iAnswer.GT.0) THEN
            XMessageBox = iAnswer
            CALL XRegClose(hKey)
            RETURN
      ELSE
            nCheck = 1
      END IF
END IF

jFlags = 0
IF (PRESENT(iFlags)) jFlags=iFlags

bQuitting = PeekMessage(Msg, 0, WM_QUIT, WM_QUIT, PM_REMOVE).NE.0
IF (bQuitting) iExitCode = Msg%wParam

hUser32 = GetModuleHandle("user32"C)
lpMBGetString = GetProcAddress(hUser32, "MB_GetString"C)

!Determine appropriate icon
nButtons = 3
nIcons = 0
hInst = GetModuleHandle(0)
IF (PRESENT(hModule)) hInst = hModule

IF (PRESENT(idIcon)) THEN
      jdIcon = idIcon
      nIcons = 1
ELSE IF (IAND(jFlags,MB_ICONMASK).NE.0) THEN
      SELECT CASE(IAND(jFlags,MB_ICONMASK))
      CASE(MB_ICONHAND)
            jdIcon = 103
      CASE(MB_ICONQUESTION)
            jdIcon = 102
      CASE(MB_ICONEXCLAMATION)
            jdIcon = 101
      CASE(MB_ICONASTERISK)
            jdIcon = 104
      END SELECT
      hInst = hUser32
      nIcons = 1
END IF

iDBY = GetDialogBaseUnits()
iDBX = IAND(iDBY, Z'FFFF')
iDBY = ISHL(iDBY, -16)
iCstep = 0

!Determine text dimensions
lenText = LEN_TRIM (sText)
hDC = GetDC(0)
!            select current message box font for this version of windows into the DC
orgFont = SelectObject (hDC, XMessageFontHndl () )
Rect = T_RECT(0,0,700,600)
iStaticHeight = DrawText(hDC, sText, lenText, Rect, DT_FIT)
!           in case of a multi-line textbox, make box as narrow as possible
!            without adding additional lines, so lines become appproximately
!             the same width
      IF (iStaticHeight / iDBY .GT. 1) THEN        ! test line count
         iCstep = 5 * iDBX
         iTryWd = iCstep                           ! start very narrow
         Rect = T_RECT (0,0, iTryWd, 600)
         i = DrawText(hDC, sText, lenText, Rect, DT_FIT)
         DO WHILE (i .GT. iStaticHeight .AND. iTryWd .LT. 700)
!              additional line was reqd., try a wider rectangle
            iTryWd = MAX (iTryWd + iCstep,  Rect%Right)
            Rect = T_RECT (0,0, iTryWd, 600)
            i = DrawText(hDC, sText, lenText, Rect, DT_FIT)
         END DO
      ENDIF
      Rect%Right = Rect%Right + MAX (Rect%Right/10, iCstep)  ! add margin to prevent clipping
!           wrapup DC
iSt = SelectObject (hDC, orgFont )
iSt = ReleaseDC(0, hDC)

!Set text box width & height in dialog units
!was!   iTxtDWD = (4*Rect%Right    + iDBX - 1)/iDBX
!was!   iTxtDHT = (8*iStaticHeight + iDBY - 1)/iDBY
!           boost by 50% for Windows 7 & hi-res monitors
iTxtDWD = (6*Rect%Right     + iDBX - 1)/iDBX
iTxtDHT = (12*iStaticHeight + iDBY - 1)/iDBY
IF (iTxtDHT .LE. 0) iTxtDWD = 0     ! if no text, zero textbox size

!Determine which buttons are necessary:
IF (PRESENT(sUserButton)) THEN
      nButtons = MIN(4, SIZE(sUserButton))
      idButton(1:nButtons) = (/(i,i=1,nButtons)/)
ELSE
      SELECT CASE(IAND(jFlags, MB_TYPEMASK))
      CASE(MB_OK)
            nButtons = 1
            idButton(1) = IDOK
      CASE(MB_OKCANCEL)
            nButtons = 2
            idButton(1:nButtons) = (/IDOK, IDCANCEL/)
      CASE(MB_ABORTRETRYIGNORE)
            nButtons = 3
            idButton(1:nButtons) = (/IDABORT, IDRETRY, IDIGNORE/)
      CASE(MB_YESNOCANCEL)
            nButtons = 3
            idButton(1:nButtons) = (/IDYES, IDNO, IDCANCEL/)
      CASE(MB_YESNO)
            nButtons = 2
            idButton(1:nButtons) = (/IDYES, IDNO/)
      CASE(MB_RETRYCANCEL)
            nButtons = 2
            idButton(1:nButtons) = (/IDRETRY, IDCANCEL/)
      END SELECT
END IF


!Determine dialog size
iWidth = MAX(200,                                         &    !minimum width
              20 + iTxtDWD + nIcons*(32*4/iDBX + 10),     &    !side margins, text, and icon
              (nButtons + 1)*BTN_SPACING - BTN_WIDTH )         !Button array width = n(WD) + (n+1)(SP-WD)

iHeight = 6 + (BTN_HEIGHT + 10) +               &                             !Buttons' height
         nCheck*(CHECK_HEIGHT) +                &                             !Check box's height
         MAX(iTxtDHT, nIcons*(32*8/iDBY) ) +    &                             !Text or icon height
         (GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYDLGFRAME))*8 / iDBY  !Caption + frame height


IF (PRESENT(xWnd)) THEN
      hWnd = xWnd%hWnd
ELSE IF (ASSOCIATED(xgApp%xFrame)) THEN
      hWnd = xgApp%xFrame%hWnd
ELSE
      hWnd = GetDesktopWindow()
END IF

DT%style = WS_POPUP.OR.WS_VISIBLE.OR.DS_CENTER.OR.DS_MODALFRAME.OR.   &
     &     WS_CAPTION.OR.DS_SETFONT.OR.WS_SYSMENU.OR.DS_SETFOREGROUND
DT%dwExtendedStyle = 0
IF (IAND(jFlags, MB_SYSTEMMODAL).NE.0) THEN
      DT%style = DT%style.OR.DS_SYSMODAL
      DT%dwExtendedStyle = WS_EX_TOPMOST
END IF
IF (IAND(jFlags, MB_TOPMOST).NE.0) DT%dwExtendedStyle = WS_EX_TOPMOST
DT%cdit = 1 + nIcons + nButtons + nCheck
DT%x = 0
DT%y = 0
DT%cx = iWidth
DT%cy = iHeight

iPos = 0

lpDt = GlobalAlloc(GMEM_FIXED, 2*(LEN(sText)+LEN(sCaption)+200))

!<qt2018-12-06 annotation
! see DLGTEMPLATE structure in WinSDK description:
! Immediately after the DLGTEMPLATE structure three arrays are following
! These arrays specify the menu, class, and title for the dialog box.
!
! Memory has been allocated which is associated with iDt(:).
!
! 1. DT is copied to iDt(:) (18 bytes)
! 2. Menu: 0x0000, the dialog box has no menu
! 3. Class: 0x0000, use predefined dialog box class
! 4. Caption: title array that specifies a null-terminated Unicode string 
! 5. Font: The 16-bit point size value and the typeface array, 
!          but only if the style member specifies the DS_SETFONT style. 
!>

!Dlgtemplate
iSize = SIZEOF(DT)/2
iDt(iPos:iPos+iSize-1) = TRANSFER(DT, i2, iSize)
!<qt2018-12-07#: it appears that the following PXPutInt2 overwrites the last 
!                2 bytes of the previous copied DT
!#iPos = iPos+iSize-1
iPos = iPos+iSize
!>
!Menu/Class
iPos = PXPutInt2(iDt, iPos, (/0_2,0_2/))
!Caption
IF (PRESENT(sCaption)) THEN
      iPos = PXPutChar(iDt, iPos, sCaption)
ELSE
      iPos = PXPutChar(iDt, iPos, "Error")
END IF

!Font
 iSt = GetObject(GetStockObject(DEFAULT_GUI_FONT), SIZEOF(LF), LOC(LF))
 CALL XGetMessageFont (LF)
 iPos = PXPutInt2(iDt, iPos, (/INT2(LF%lfHeight)/))
 iPos = PXPutChar(iDt, iPos, LF%lfFaceName(1:INDEX(LF%lfFaceName,CHAR(0))-1))

!Align to DWORD
IF (MOD(iPos,2).EQ.1) iPos=iPos+1

!Text
iStaticStyle = WS_VISIBLE.OR.WS_CHILD
IF (IAND(jFlags, MB_RIGHT).NE.0) iStaticStyle = IOR(iStaticStyle, SS_RIGHT)
iPos = PXPutControl(iDt, iPos, iStaticStyle, 0,   &
                    20+nIcons*20, 10, iTxtDWD, iTxtDHT, 0, DIT_STATIC, TRIM(sText) )

IF (nIcons.NE.0) THEN
      iPos = PXPutControl(iDt, iPos, WS_VISIBLE.OR.WS_CHILD.OR.SS_ICON.OR.SS_REALSIZEIMAGE, 0, &
                        10, 10, 20, 20, 0, DIT_STATIC, idIcon = jdIcon)
END IF

IF (PRESENT(sRegKey) .AND. PRESENT(sRegValue)) THEN
      iPos = PXPutControl(iDt, iPos, WS_VISIBLE.OR.WS_CHILD.OR.BS_AUTOCHECKBOX, 0, &
                        10, iHeight-32, iWidth-20, CHECK_HEIGHT, IDC_CHECK,      &
                        DIT_BUTTON, "&Show this message in the future")
END IF

iDefButton = ISHL(IAND(jFlags,MB_DEFMASK),-8)+1
DO i=1,nButtons
      iStyle = WS_VISIBLE.OR.WS_CHILD
      IF (iDefButton.EQ.i) iStyle = iStyle.OR.BS_DEFPUSHBUTTON

      IF (PRESENT(sUserButton)) THEN
            iPos = PXPutControl(iDt, iPos, iStyle, 0,                                                     &
                              iWidth/2 - (nButtons-1)*BTN_SPACING/2 + (i-1)*BTN_SPACING - BTN_WIDTH/2,    &
                              iHeight-20,                                                                 &
                              BTN_WIDTH, BTN_HEIGHT, idButton(i), DIT_BUTTON, TRIM(sUserButton(i))//CHAR(0))

      ELSE IF (lpMBGetString.NE.0) THEN
            pwBtnText = MB_GetString(idButton(i)-1)
            iPos = PXPutControl(iDt, iPos, iStyle, 0,                                                       &
                              iWidth/2 - (nButtons-1)*BTN_SPACING/2 + (i-1)*BTN_SPACING - BTN_WIDTH/2,    &
                              iHeight-20,                                                                 &
                              BTN_WIDTH, BTN_HEIGHT, idButton(i), DIT_BUTTON, ws=wBtnText)
      ELSE
            iPos = PXPutControl(iDt, iPos, iStyle, 0,                                                       &
                              iWidth/2 - (nButtons-1)*BTN_SPACING/2 + (i-1)*BTN_SPACING - BTN_WIDTH/2, iHeight-20,  &
                              BTN_WIDTH, BTN_HEIGHT, idButton(i), DIT_BUTTON, sDefBtnText(idButton(i)))
      END IF
END DO

IF (IAND(jFlags,MB_SYSTEMMODAL).NE.0) THEN
      iSt = EnumWindows(LOC(PXMBEnableProc), 0)
ELSE IF (IAND(jFlags,MB_TASKMODAL).NE.0) THEN
      iSt = EnumThreadWindows(GetCurrentThreadID(), LOC(PXMBEnableProc), 0)
END IF

!IF (IAND(jStyle,MB_MODELESS).EQ.0) THEN
XMessageBox = DialogBoxIndirectParam(hInst, lpDt, hWnd, LOC(PXMessageBoxDlgProc), idButton(iDefButton))

IF (XMessageBox.GE.100) THEN
   !Check box was unchecked
   XMessageBox = -XMessageBox/100
ELSE IF (XMessageBox.LT.0) THEN
   !Failure
   XMessageBox = 0
   !<qt2018-12-06+
   iSt = GetLastError() ! wanna see why it failed (returned 1407: window class not found)
   !>
END IF
!ELSE
!   XMessageBox = CreateDialogIndirectParam_(hInst, lpDt, hWnd, LOC(PXMessageBoxDlgProc), idButton(iDefButton))
!END IF

IF (IAND(jFlags,MB_SYSTEMMODAL).NE.0) THEN
   iSt = EnumWindows(LOC(PXMBEnableProc), 1)
ELSE IF (IAND(jFlags,MB_TASKMODAL).NE.0) THEN
   iSt = EnumThreadWindows(GetCurrentThreadID(), LOC(PXMBEnableProc), 1)
END IF

IF (PRESENT(sRegKey) .AND. PRESENT(sRegValue) .AND. XMessageBox.LT.0) THEN
   iSt = XRegWrite(hKey, sRegValue, ABS(XMessageBox))
   CALL XRegClose(hKey)
END IF

XMessageBox = ABS(XMessageBox)

iSt = GlobalFree(lpDt)

IF (bQuitting) CALL PostQuitMessage(iExitCode)

END FUNCTION XMessageBox

!======================================================================
!Appends a control (DLGITEMTEMPLATE) into a DLGTEMPLATE stream used by XMessageBox
INTEGER FUNCTION PXPutControl(iDt, iPos, iStyle, iExtendedStyle, &
                  x, y, cx, cy, id, iType, sTitle, idIcon, ws) RESULT(newPos)

INTEGER(2), INTENT(INOUT)::   iDt(0:*)
INTEGER, INTENT(IN)::         iPos
INTEGER, INTENT(IN)::         iStyle
INTEGER, INTENT(IN)::         iExtendedStyle
INTEGER, INTENT(IN)::         x, y
INTEGER, INTENT(IN)::         cx, cy
INTEGER, INTENT(IN)::         id
INTEGER, INTENT(IN)::         iType
CHARACTER(*), OPTIONAL, INTENT(IN)::   sTitle
INTEGER, OPTIONAL, INTENT(IN)::   idIcon
INTEGER(2), OPTIONAL, INTENT(IN):: ws(*)

INTEGER::                     i, iTerm

newPos = PXPutInt4(iDt, iPos, iStyle)
newPos = PXPutInt4(iDt, newPos, iExtendedStyle)
newPos = PXPutInt2(iDt, newPos, INT2((/x,y,cx,cy,id,-1,iType/)))
IF (PRESENT(sTitle)) THEN
   newPos = PXPutChar(iDt, newPos, sTitle)
ELSE IF (PRESENT(idIcon)) THEN
   newPos = PXPutInt2(iDt, newPos, INT2((/-1,idIcon/)) )
ELSE IF (PRESENT(ws)) THEN
   DO iTerm=1,100
      IF (ws(iTerm).EQ.0) EXIT
   END DO
   newPos = PXPutInt2(iDt, newPos, ws(1:iTerm))
END IF
newPos = PXPutInt2(iDt, newPos, INT2((/0/)))
!Align to DWORD
IF (MOD(newPos,2).EQ.1) newPos=newPos+1

END FUNCTION PXPutControl

!======================================================================
!Appends a string into a DLGTEMPLATE stream used by XMessageBox
INTEGER FUNCTION PXPutChar(iDt, iPos, s) RESULT(newPos)

INTEGER(2), INTENT(INOUT)::      iDt(0:*)
INTEGER, INTENT(IN)::            iPos
CHARACTER(*), INTENT(IN)::       s
INTEGER(2)::   w(LEN(s)+1)

INTEGER:: iSt

iSt = XFTAPI_MultiByteToWideChar(0, 0, s, LEN(s), w, LEN(s)+1)
w(LEN(s)+1) = 0
iDt(iPos:iPos+LEN(s)) = TRANSFER(w, w, LEN(s)+1)
newPos = iPos+LEN(s)+1

END FUNCTION PXPutChar

!======================================================================
!Appends an array of integer(2) into a DLGTEMPLATE stream used by XMessageBox
INTEGER FUNCTION PXPutInt2(iDt, iPos, i2) RESULT(newPos)

INTEGER(2), INTENT(INOUT)::      iDt(0:*)
INTEGER, INTENT(IN)::            iPos
INTEGER(2), INTENT(IN)::         i2(:)

iDt(iPos:iPos+SIZE(i2)-1) = i2
newPos = iPos+SIZE(i2)

END FUNCTION PXPutInt2

!======================================================================
!Appends an integer(4) into a DLGTEMPLATE stream used by XMessageBox
INTEGER FUNCTION PXPutInt4(iDt, iPos, i4) RESULT(newPos)

INTEGER(2), INTENT(INOUT)::      iDt(0:*)
INTEGER, INTENT(IN)::            iPos
INTEGER, INTENT(IN)::            i4

iDt(iPos:iPos+1) = TRANSFER(i4, iDt(1), 2)
newPos = iPos+2

END FUNCTION PXPutInt4

!======================================================================
!Enables or disables all windows which were disabled by XMessageBox
INTEGER FUNCTION PXMBEnableProc(hWnd, bEnable)
!DEC$ATTRIBUTES STDCALL:: PXMBEnableProc

INTEGER, INTENT(IN)::   hWnd
LOGICAL, INTENT(IN)::   bEnable

INTEGER::               iSt

IF (IAND(GetWindowLong(hWnd, GWL_STYLE), WS_CHILD).EQ.0) THEN
   iSt = EnableWindow(hWnd, bEnable)
END IF

PXMBEnableProc = 1

END FUNCTION PXMBEnableProc

!======================================================================
!Dialog box procedure for XMessageBox
INTEGER FUNCTION PXMessageBoxDlgProc(hWnd, Msg, wParam, lParam)
!DEC$ATTRIBUTES STDCALL:: PXMessageBoxDlgProc

INTEGER::         hWnd, Msg, wParam, lParam

TYPE(T_RECT)::    Rect, WinRect

INTEGER::         iSt, hParent, iSign, hCheck

SELECT CASE (Msg)
CASE(WM_INITDIALOG)
      !Center window
      hParent = GetParent(hWnd)
      IF (hParent.EQ.0) hParent = GetDesktopWindow()
      iSt = GetWindowRect(hWnd, Rect)
      iSt = GetWindowRect(hParent,WinRect)
      iSt = SetWindowPos(hWnd, 0,                                    &
         MAX((WinRect%Right + WinRect%Left - Rect%Right + Rect%Left)/2, 0), &
         MAX((WinRect%Bottom + WinRect%Top - Rect%Bottom+Rect%Top)/2,   0), &
         0, 0, SWP_NOSIZE.OR.SWP_NOZORDER)
      !Set focus to the default button
      iSt = SetFocus(GetDlgItem(hWnd, lParam))

      iSt = SendMessage(GetDlgItem(hWnd, IDC_CHECK), BM_SETCHECK, 1, 0)

      PXMessageBoxDlgProc = 0
CASE(WM_COMMAND)
   IF (IAND(wParam,Z'FFFF').NE.IDC_CHECK) THEN
      hCheck = GetDlgItem(hWnd, IDC_CHECK)
      iSign = 1
      !If the check box exist and is unchecked, return a negative value.
      IF (hCheck.NE.0) THEN
         IF (SendMessage(hCheck, BM_GETCHECK, 0, 0).EQ.0) iSign = 100
      END IF
      iSt = EndDialog(hWnd, iSign * IAND(wParam, Z'FFFF'))
   END IF
   PXMessageBoxDlgProc = 0
CASE DEFAULT
   PXMessageBoxDlgProc = 0
END SELECT


END FUNCTION PXMessageBoxDlgProc
!======================================================================
!Enables all thread windows which were disabled by XModalDialog
LOGICAL FUNCTION PXEnableProc(hWnd, hDialog)
!MS$ATTRIBUTES STDCALL::      PXEnableProc

INTEGER, INTENT(IN)::      hWnd, hDialog
INTEGER::                  iSt

IF (IAND(GetWindowLong(hWnd, GWL_STYLE), WS_CHILD).EQ.0) THEN
   IF (hWnd.NE.hDialog) iSt = EnableWindow(hWnd, .TRUE.)
END IF

PXEnableProc = .TRUE.

END FUNCTION PXEnableProc

!======================================================================
!Disables all thread windows as result of call to XModalDialog
LOGICAL FUNCTION PXDisableProc(hWnd, hDialog)
!MS$ATTRIBUTES STDCALL::      PXDisableProc

INTEGER, INTENT(IN)::      hWnd, hDialog
INTEGER::                  iSt

IF (hWnd.NE.hDialog .AND. .NOT.IsChild(hDialog,hWnd)) iSt = EnableWindow(hWnd, .FALSE.)
PXDisableProc = .TRUE.

END FUNCTION PXDisableProc
!======================================================================
!Checks if the dialog has associated DLGINIT resource (for combos and lists)
!and loads it.
SUBROUTINE PXParseDlgInit(hModule, hDialog, idDialog)

INTEGER, INTENT(IN)::      hModule
INTEGER, INTENT(IN)::      hDialog
INTEGER, INTENT(IN)::      idDialog

INTEGER::                  hResource, iErr, iPos, hCtl, iSt, iResSize
CHARACTER::                sData(*); POINTER(pData, sData)
TYPE(X_CONTROL)::          xCtl;     POINTER(pxCtl, xCtl)
TYPE(T_DLGINIT)::          DI

hResource = FindResource(hModule, idDialog, 240) !loc("DLGINIT"C))
IF (hResource.EQ.0) RETURN
iResSize = SizeOfResource(hModule, hResource)

hResource = LoadResource(hModule, hResource)
IF (hResource.EQ.0) RETURN

pData = LockResource(hResource)
iPos = 1
DO WHILE(.TRUE.)
      IF (iPos.GE.iResSize-1) EXIT

      DI = TRANSFER(sData(iPos:iPos+SIZEOF(DI)), DI)

      IF (DI%idCtl.EQ.0) EXIT

      hCtl = GetDlgItem(hDialog, INT(DI%idCtl))
      IF (hCtl.NE.0 .AND. DI%iType.EQ.Z"0403") THEN
            pxCtl = FXCtlByHandle(hCtl)
            IF (pxCtl.NE.0) THEN
                  SELECT CASE(xCtl%iType)
                  CASE(XCTL_COMBO, XCTL_DROPDOWN)
                        iSt = SendMessage(hCtl, CB_ADDSTRING, 0, pData+iPos+SIZEOF(DI)-1)
                  CASE(XCTL_LIST)
                        iSt = SendMessage(hCtl, LB_ADDSTRING, 0, pData+iPos+SIZEOF(DI)-1)
                  END SELECT
            END IF
      END IF
      iPos = iPos + DI%iLen + SIZEOF(DI)
END DO



END SUBROUTINE PXParseDlgInit


END MODULE XFTDialog
