ATSHOWMSG Default PushButton

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic


   

I've used the ATSHOWMSG sample creating a new dialog that provides yes and no buttons.  I'd like the default to be the "NO" button but I cannot figure out how to do it.  I've tried searching online to no avail so I am posting here to see if someone else has done something like this and can guide me on what I need to do.  Below is the code I've been working with. 
Thanks in advance
 
==============================================
 
 
Sub Main()
On Error Resume Next
ShowMessageDialog
End Sub
Const WM_CLOSE = &H10
Const WM_SETFONT = &H30
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Declare Function CreateFontA Lib "gdi32" (ByVal nHeight As Long,ByVal nWidth As Long,ByVal nEscapement As Long,ByVal nOrientation As Long,ByVal fnWeight As Long,ByVal fdwItalic As Long,ByVal fdwUnderline As Long,ByVal fdwStrikeOut As Long,ByVal fdwCharSet As Long ,ByVal fdwOutputPrecision As Long,ByVal fdwClipPrecision As Long,ByVal fdwQuality As Long,ByVal fdwPitchAndFamily As Long,ByVal lpszFace As String) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long,ByVal nIndex As Long) As Long
Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long,ByVal nIDDlgItem As Long) As Long
Declare Function GetDialogBaseUnits Lib "user32" () As Long
Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long,ByVal hDC As Long) As Long
Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hDialog As Long
Dim hFont As Long
Dim Endtime As Long
Sub ShowMessageDialog
Dim hDC As Long
Dim FontHeight As Long
Dim DUX  As Long
Dim DUY As Long
Dim HorzRes As Long
Dim VertRes As Long
Dim TextWidth As Long
Dim TextHeight As Long
Dim Title As String
Dim Message As String
Dim Size As Long
Dim Timeout As Long
On Error Resume Next
Title="TEST"
Message="HELLO WORLD"
Size=16
Timeout=0
If Timeout > 0 Then Endtime = CLng(Timer) + Timeout Else Endtime = 0
DUY = GetDialogBaseUnits()
DUX = DUY And &h7fff&
DUY = Int(DUY / &h10000&)
hDC = GetWindowDC(0)
HorzRes = GetDeviceCaps(hDC,LOGPIXELSX)
VertRes = GetDeviceCaps(hDC,LOGPIXELSY)
FontHeight = Size * VertRes / 72
ReleaseDC 0,hDC
hFont = CreateFontA(-FontHeight,0,0,0,700,0,0,0,0,0,0,0,0,"Arial")
TextHeight = 5 + (1 * Int(FontHeight * 18 / DUY))
TextWidth = Int(FontHeight * 36 / DUX)
If TextWidth < 380 Then TextWidth = 380
Begin Dialog UserDialog TextWidth+20,TextHeight+50,Title,.DialogFunc
Text 10,10,TextWidth,TextHeight,Message,.Text1,2
PushButton (TextWidth/2)-90,TextHeight+20,90,20,"&Yes"
PushButton (TextWidth/2),TextHeight+20,90,20,"&No"
End Dialog

Dim dlg As UserDialog
Dim resp
resp = Dialog(dlg)
  DeleteObject hFont
  InitSession.Activate
  InitSession.Output  CStr(resp) & vbCr
End Sub
Private Function DialogFunc(DlgItm$, Action%, SuppVal&) As Boolean
Select Case Action%
  Case 1
      hDialog = SuppVal&
      SendMessageA (GetDlgItem(hDialog,DlgControlId("Text1")),WM_SETFONT,hFont,1)
     Case 5
         If Endtime>0 Then
             If CLng(Timer) >= Endtime Then
                 SendMessageA hDialog,WM_CLOSE,0,0
             Else
                 DialogFunc = True
                 Wait 1
              End If
        End If
   End Select
  End Function
Sub Dummy
End Sub