'variables used to ensure a flickerless image swapping
Private curIndex As Byte
Private onButton As Boolean
'API declarations for dragging form
Private Declare Sub ReleaseCapture Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
'procedure to drag a no-titlebar form
Private Sub FormDrag(frmName As Form)
ReleaseCapture
Call SendMessage(frmName.hWnd, &HA1, 2, 0&)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyReturn
'checks the layout used, and returns the OK/Yes value
If attBoxLayout = 0 Then
attContext = attOK
Unload Me
ElseIf attBoxLayout = 1 Then
attContext = attOK
Unload Me
ElseIf attBoxLayout = 2 Then
attContext = attYes
Unload Me
End If
Case vbKeyEscape
'checks the layout used, and returns the Cancel/No value
If attBoxLayout = 0 Then
attContext = attOK
Unload Me
ElseIf attBoxLayout = 1 Then
attContext = attCancel
Unload Me
ElseIf attBoxLayout = 2 Then
attContext = attNo
Unload Me
End If
End Select
End Sub
Private Sub Form_Load()
Beep
End Sub
'swaps the buttons to unhighlighted state
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Swap2Orig
End Sub
'uses the procedure to enable form movement
Private Sub lblDrag_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub
'swaps the buttons to unhighlighted state
Private Sub lblDrag_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Swap2Orig
End Sub
'swaps the button to the pressed state
Private Sub picB_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If attBoxLayout = 0 Then
Set picB(0).Picture = picOk3
ElseIf attBoxLayout = 1 Then
If index = 0 Then
Set picB(0).Picture = picCancel3
Else
Set picB(1).Picture = picOk3
End If
ElseIf attBoxLayout = 2 Then
If index = 0 Then
Set picB(0).Picture = picNo3
Else
Set picB(1).Picture = picYes3
End If
End If
End Sub
'swaps button to the highlighted state
Private Sub picB_MouseMove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not curIndex = index Then
onButton = False
End If
If onButton = True Then Exit Sub
curIndex = index
onButton = True
If attBoxLayout = 0 Then
Set picB(0).Picture = picOk2
ElseIf attBoxLayout = 1 Then
If index = 0 Then
Set picB(1).Picture = picOk
Set picB(0).Picture = picCancel2
Else
Set picB(1).Picture = picOk2
Set picB(0).Picture = picCancel
End If
ElseIf attBoxLayout = 2 Then
If index = 0 Then
Set picB(1).Picture = picYes
Set picB(0).Picture = picNo2
Else
Set picB(1).Picture = picYes2
Set picB(0).Picture = picNo
End If
End If
End Sub
'executes when the user releases a pressed button
Private Sub picB_MouseUp(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'ensures that the cursor is still over the button otherwise cancel
If X < 0 Or X > picB(index).Width Then
Call Swap2Hilyt(index)
Exit Sub
End If
If Y < 0 Or Y > picB(index).Height Then
Call Swap2Hilyt(index)
Exit Sub
End If
'checks the layout used, the value pressed and returns it
If attBoxLayout = 0 Then
Set picB(0).Picture = picOk2
attContext = attOK
Unload Me
ElseIf attBoxLayout = 1 Then
If index = 0 Then
Set picB(0).Picture = picCancel2
attContext = attCancel
Unload Me
Else
Set picB(1).Picture = picOk2
attContext = attOK
Unload Me
End If
ElseIf attBoxLayout = 2 Then
If index = 0 Then
Set picB(0).Picture = picNo2
attContext = attNo
Unload Me
Else
Set picB(1).Picture = picYes2
attContext = attYes
Unload Me
End If
End If
End Sub
'prevents textbox to receive focus
Private Sub txtNoScroll_GotFocus()
picB(0).SetFocus
End Sub
'swaps buttons to unhighlighted state
Private Sub txtNoScroll_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Swap2Orig
End Sub
'prevents textbox to receive focus
Private Sub txtScroll_GotFocus()
picB(0).SetFocus
End Sub
'swaps buttons to unhighlighted state
Private Sub txtScroll_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Swap2Orig
End Sub
'procedure used to swap the buttons to the highlighted unpressed state
Private Sub Swap2Hilyt(index As Integer)
If attBoxLayout = 0 Then
Set picB(0).Picture = picOk2
ElseIf attBoxLayout = 1 Then
If index = 0 Then
Set picB(0).Picture = picCancel2
Else
Set picB(1).Picture = picOk2
End If
ElseIf attBoxLayout = 2 Then
If index = 0 Then
Set picB(0).Picture = picNo2
Else
Set picB(1).Picture = picYes2
End If
End If
End Sub
'procedure used to swap the buttons to the unhighlighted unpressed state
