|
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
|