Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdNext_Click()
    frmVBCalWiz2.Show
    Unload Me
End Sub


Private Sub Form_Load()
    `Preset today's date
    If gdtmDate1 = 0 Then
        gdtmDate1 = Date
        gdtmDate2 = Date
        gdtmDate3 = Date
    End If
    `Display the prompting text
    lblPrompt.Caption = "This example wizard " & _
        "demonstrates three controls that let " & _
        "you select dates as it helps you " & _
        "calculate the number of days " & _
        "between two dates."
    `Center form
    Move (Screen.Width - Width) \ 2, _
         (Screen.Height - Height) \ 2
    Show
    cmdNext.SetFocus
End Sub

Option Explicit

Private Sub cmdBack_Click()
    gdtmDate1 = dtpDemo
    frmVBCalWiz1.Show
    Unload Me
End Sub

Private Sub cmdNext_Click()
    gdtmDate1 = dtpDemo
    frmVBCalWiz3.Show
    Unload Me
End Sub

Private Sub Form_Load()
    `Center form
    Move (Screen.Width - Width) \ 2, _
         (Screen.Height - Height) \ 2
    Show

    dtpDemo = gdtmDate1
    cmdNext.SetFocus
End Sub

Option Explicit

Private Sub cmdBack_Click()
    gdtmDate2 = mvwDemo.Value

    frmVBCalWiz2.Show
    Unload Me
End Sub

Private Sub cmdNext_Click()
    gdtmDate2 = mvwDemo.Value
    frmVBCalWiz4.Show
    Unload Me
End Sub

Private Sub Form_Load()
    `Center form
    Move (Screen.Width - Width) \ 2, _
         (Screen.Height - Height) \ 2
    Show
    mvwDemo.Value = gdtmDate2
    cmdNext.SetFocus
End Sub

Private Sub mvwDemo_DateDblClick(ByVal DateDblClicked As Date)
    `Allow double-click to select a date
    cmdNext_Click
End Sub

Option Explicit

Private Sub calDemo_DblClick()
    `Allow double-click selection of date
    cmdNext_Click
End Sub

Private Sub cmdBack_Click()
    gdtmDate3 = calDemo.Value
    frmVBCalWiz3.Show
    Unload Me
End Sub

Private Sub cmdNext_Click()
    gdtmDate3 = calDemo.Value

    frmVBCalWiz5.Show
    Unload Me
End Sub

Private Sub cmdToday_Click()
    `Reset selected date to today
    calDemo.Value = Date
End Sub

Private Sub Form_Load()
    `Center form
    Move (Screen.Width - Width) \ 2, _
         (Screen.Height - Height) \ 2
    calDemo.Value = gdtmDate3
End Sub

Option Explicit

Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub cmdBack_Click()
    frmVBCalWiz4.Show
    Unload Me
End Sub

Private Sub Form_Load()
    `Center this form
    Move (Screen.Width - Width) \ 2, _
         (Screen.Height - Height) \ 2
    lblReport.Caption = "Number of days separating " _
        & "these dates:" & vbCrLf & vbCrLf & "Between " _
        & Format$(gdtmDate1, "mm/dd/yyyy") & " and " _
        & Format$(gdtmDate2, "mm/dd/yyyy") & " is " _
        & Abs(gdtmDate1 - gdtmDate2) & vbCrLf & "Between " _
        & Format$(gdtmDate2, "mm/dd/yyyy") & " and " _
        & Format$(gdtmDate3, "mm/dd/yyyy") & " is " _
        & Abs(gdtmDate2 - gdtmDate3) & vbCrLf & "Between " _
        & Format$(gdtmDate3, "mm/dd/yyyy") & " and " _
        & Format$(gdtmDate1, "mm/dd/yyyy") & " is " _
        & Abs(gdtmDate3 - gdtmDate1)
End Sub

Option Explicit

Public gdtmDate1 As Date
Public gdtmDate2 As Date
Public gdtmDate3 As Date

Option Explicit

Public gintHourHandColor As Integer
Public gintMinuteHandColor As Integer
Public gintSecondHandColor As Integer
Private mintHnum As Integer
Private mintMnum As Integer
Private mintSnum As Integer
Private mlngHcolor As Long
Private mlMcolor As Long
Private mlngScolor As Long
Private msngHlen As Single
Private msngMlen As Single
Private msngSlen As Single
Private mstrAppname As String
Private mstrSection As String
Private mstrKey As String
Private mstrSetting As String

Private Const sngPi = 3.141593!
Private Const sngTwoPi = sngPi + sngPi
Private Const sngHalfPi = sngPi / 2

Private Sub Form_Load()
    `Fill form exactly with background image
    picBackGround.Move 0, 0
    Me.Width = picBackGround.Width + (Me.Width - ScaleWidth)
    Me.Height = picBackGround.Height + (Me.Height - ScaleHeight)
    `Change the scaling of the clock face
    picBackGround.Scale (-2, -2)-(2, 2)
    `Center form
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
    `Set width of hands in pixels

    picBackGround.DrawWidth = 5
    `Set length of hands
    msngHlen = 0.8
    msngMlen = 1.5
    msngSlen = 1
    `Set colors of hands from Registry settings
    mstrAppname = "VBClock"
    mstrSection = "Hands"
    mstrKey = "mlngHcolor"
    mstrSetting = GetSetting(mstrAppname, mstrSection, mstrKey)
    gintHourHandColor = Val(mstrSetting)
    mstrKey = "mlMcolor"
    mstrSetting = GetSetting(mstrAppname, mstrSection, mstrKey)
    gintMinuteHandColor = Val(mstrSetting)
    mstrKey = "mlngScolor"
    mstrSetting = GetSetting(mstrAppname, mstrSection, mstrKey)
    gintSecondHandColor = Val(mstrSetting)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    `Save current hand colors
    mstrKey = "mlngHcolor"
    mstrSetting = Str$(gintHourHandColor)
    SaveSetting mstrAppname, mstrSection, mstrKey, mstrSetting
    mstrKey = "mlMcolor"
    mstrSetting = Str$(gintMinuteHandColor)
    SaveSetting mstrAppname, mstrSection, mstrKey, mstrSetting
    mstrKey = "mlngScolor"
    mstrSetting = Str$(gintSecondHandColor)
    SaveSetting mstrAppname, mstrSection, mstrKey, mstrSetting
End Sub

Private Sub mnuAbout_Click()
    frmAbout2.Display

End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuContents_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpContents
    cdlOne.ShowHelp
End Sub

Private Sub mnuHandColors_Click()
    `Show form for selecting hand colors
    frmVBClock2.Show vbModal
End Sub

Private Sub mnuSearch_Click()
    cdlOne.HelpFile = App.Path & "\..\..\Help\Mvbdw.hlp"
    cdlOne.HelpCommand = cdlHelpPartialKey
    cdlOne.ShowHelp
End Sub

Private Sub tmrClock_Timer()
    Dim dblHang As Double
    Dim dblMang As Double
    Dim dblSang As Double
    Dim dblHx As Double
    Dim dblHy As Double
    Dim dblMx As Double
    Dim dblMy As Double

    Dim dblSx As Double
    Dim dblSy As Double

    `Keep track of current second
    Static intLastSecond As Integer
    `Check to see if new second
    If Second(Now) = intLastSecond Then
        Exit Sub
    Else
        intLastSecond = Second(Now)
    End If
    `Update time variables
    mintHnum = Hour(Now)
    mintMnum = Minute(Now)
    mintSnum = Second(Now)
    `Calculate hand angles
    dblHang = sngTwoPi * (mintHnum + mintMnum / 60) / 12 - sngHalfPi
    dblMang = sngTwoPi * (mintMnum + mintSnum / 60) / 60 - sngHalfPi
    dblSang = sngTwoPi * mintSnum / 60 - sngHalfPi
    `Calculate endpoints for each hand
    dblHx = msngHlen * Cos(dblHang)
    dblHy = msngHlen * Sin(dblHang)
    dblMx = msngMlen * Cos(dblMang)
    dblMy = msngMlen * Sin(dblMang)
    dblSx = msngSlen * Cos(dblSang)
    dblSy = msngSlen * Sin(dblSang)
    `Restore background image
    picBackGround.Cls
    `Draw new hands
    picBackGround.Line (0, 0)-(dblMx, dblMy), _
        QBColor(gintMinuteHandColor)
    picBackGround.Line (0, 0)-(dblHx, dblHy), _
        QBColor(gintHourHandColor)
    picBackGround.Line (0, 0)-(dblSx, dblSy), _
        QBColor(gintSecondHandColor)
End Sub


Private Sub mnuSetTime_Click()
    Dim strPrompt As String
    Dim strTitle As String
    Dim strDefault As String
    Dim strStartTime As String
    Dim strTim As String
    Dim strMsg As String
    `Ask user for new time
    strPrompt = "Enter the time, using the format 00:00:00"

    strTitle = "VBClock"
    strDefault = Time$
    strStartTime = strDefault
    strTim = InputBox$(strPrompt, strTitle, strDefault)
    `Check if user clicked Cancel
    `or clicked OK with no change to time
    If strTim = "" Or strTim = strStartTime Then
        Exit Sub
    End If
    `Set new time
    On Error GoTo ErrorTrap
    Time = strTim
    Exit Sub
ErrorTrap:
    strMsg = "The time you entered is invalid. " + strTim
    MsgBox strMsg, 48, "VBClock"
    Resume Next
End Sub

Option Explicit

Private mintHourMouseX As Integer
Private mintMinuteMouseX As Integer
Private mintSecondMouseX As Integer
Private mintHourHand As Integer
Private mintMinuteHand As Integer

Private mintSecondHand As Integer

Private Sub cmdCancel_Click()
    `Cancel without changing hand colors
    Unload Me
End Sub

Private Sub cmdOK_Click()
    `Reset hand colors
    frmVBClock.gintHourHandColor = mintHourHand
    frmVBClock.gintMinuteHandColor = mintMinuteHand
    frmVBClock.gintSecondHandColor = mintSecondHand
    `Return to clock form
    Unload Me
End Sub

Private Sub Form_Activate()
    Form_Paint
End Sub

Private Sub Form_Load()
    `Get current hand colors
    mintHourHand = frmVBClock.gintHourHandColor
    mintMinuteHand = frmVBClock.gintMinuteHandColor
    mintSecondHand = frmVBClock.gintSecondHandColor
    `Scale picture boxes
    picHourColor.Scale (0, 0)-(16, 1)
    picMinuteColor.Scale (0, 0)-(16, 1)
    picSecondColor.Scale (0, 0)-(16, 1)
End Sub

Private Sub Form_Paint()
    Dim i As Integer
    `Draw the 16 colors in each color "bar"

    For i = 0 To 15
        `Draw colored boxes
        picHourColor.Line (i, 0)-(i + 1, 1), QBColor(i), BF
        picMinuteColor.Line (i, 0)-(i + 1, 1), QBColor(i), BF
        picSecondColor.Line (i, 0)-(i + 1, 1), QBColor(i), BF
    Next i
    `Draw check marks for current colors

    picHourColor.DrawWidth = 2
    picHourColor.Line (mintHourHand + 0.3, 0.5) _
        -(mintHourHand + 0.5, 0.7), QBColor(mintHourHand Xor 15)
    picHourColor.Line (mintHourHand + 0.5, 0.7) _
        -(mintHourHand + 0.8, 0.2), QBColor(mintHourHand Xor 15)
    picMinuteColor.DrawWidth = 2
    picMinuteColor.Line (mintMinuteHand + 0.3, 0.5) _
        -
(mintMinuteHand + 0.5, 0.7), QBColor(mintMinuteHand Xor 15)
    picMinuteColor.Line (mintMinuteHand + 0.5, 0.7) _
        -
(mintMinuteHand + 0.8, 0.2), QBColor(mintMinuteHand Xor 15)
    picSecondColor.DrawWidth = 2
    picSecondColor.Line (mintSecondHand + 0.3, 0.5) _
        -
(mintSecondHand + 0.5, 0.7), QBColor(mintSecondHand Xor 15)
    picSecondColor.Line (mintSecondHand + 0.5, 0.7) _
        -
(mintSecondHand + 0.8, 0.2), QBColor(mintSecondHand Xor 15)
End Sub

Private Sub picHourColor_Click()
    `Determine selected hour hand color
    mintHourHand = mintHourMouseX
    Form_Paint
End Sub

Private Sub picHourColor_MouseMove(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
    `Keep track of mouse location
    mintHourMouseX = Int(X)
End Sub

Private Sub picMinuteColor_Click()
    `Determine selected minute hand color
    mintMinuteHand = mintMinuteMouseX
    Form_Paint
End Sub

Private Sub picMinuteColor_MouseMove(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
    `Keep track of mouse location
    mintMinuteMouseX = Int(X)
End Sub

Private Sub picSecondColor_Click()
    `Determine selected second hand color
    mintSecondHand = mintSecondMouseX
    Form_Paint
End Sub

Private Sub picSecondColor_MouseMove(Button As Integer, _
    Shift As Integer, X As Single, Y As Single)
    `Keep track of mouse location
    mintSecondMouseX = Int(X)
End Sub

Option Explicit

Private Sub cmdOK_Click()
    Unload Me

End Sub

Private Sub Form_Load()
    `Center form
    Left = (Screen.Width - Width) \ 2
    Top = (Screen.Height - Height) \ 2
    `Set labels using App properties
    lblHeading.Caption = App.Title
    lblApplication.Caption = App.ProductName
    lblVB.Caption = App.Comments
    lblCopyright.Caption = App.LegalCopyright
End Sub

Public Sub Display()
    `Display self as modal
    Me.Show vbModal
End Sub

Option Explicit

Const PORT = 1
Const TELEPHONE = "1-303-494-4774"
Const SETTINGS = "14400,N,8,1"
Const BUFSIZ = 3000

Dim intNistNdx As Integer
Dim strNistBuf As String * BUFSIZ
Dim strTelephone As String
Dim strSettings As String
Dim intPort As Integer
Dim strA As String
Dim intP As Integer

Private Sub cmdCancel_Click()

    Unload Me
End Sub

Private Sub Form_Load()
    `Locate form near upper-left corner
    Me.Left = (Screen.Width - Me.Width) * 0.1
    Me.Top = (Screen.Height - Me.Height) * 0.1
    `Display first informational message

    lblInformation.Caption = _
        "Dialing National Institute of Standards " & _
        "and Technology Telephone Time Service"
    `Show form and first message
    Show
    `Load port and telephone number from text file
    strTelephone = TELEPHONE
    intPort = PORT
    strSettings = SETTINGS
    Open App.Path & "\Nisttime.txt" For Binary As #1
    If LOF(1) = 0 Then
        Close #1
        `Create file the first time
        Open App.Path & "\Nisttime.txt" For Output As #1
        Print #1, "PORT" & Str(intPort)
        Print #1, "TELEPHONE " & strTelephone
        Print #1, "SETTINGS " & strSettings
    End If
    Close #1
    Open App.Path & "\Nisttime.txt" For Input As #1
    Do Until EOF(1)
        Line Input #1, strA
        strA = UCase$(strA)
        intP = InStr(strA, "PORT")
        If intP Then intPort = Val(Mid(strA, intP + 4))

        intP = InStr(strA, "TELEPHONE")
        If intP Then strTelephone = Mid(strA, intP + 9)
        intP = InStr(strA, "SETTINGS")
        If intP Then strSettings = Mid(strA, intP + 8)
    Loop
    Close #1
    `Set up MSComm control parameters
    comControl.CommPort = intPort
    comControl.SETTINGS = strSettings
    `Set to read entire buffer
    comControl.InputLen = 0
    comControl.PortOpen = True
    `Send command to dial NIST
    comControl.Output = "ATDT" + strTelephone + vbCr
    `Activate timers
    tmrGetBytes.Enabled = True
    tmrWatchDog.Enabled = True
    `Enable Cancel button

    cmdCancel.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    `This usually hangs up phone
    comControl.DTREnable = False
    `The following also hangs up phone
    Pause 1500
    `Update message for user
    lblInformation.Caption = "Hanging up"
    Refresh
    `Send commands to control modem
    comControl.Output = "+++"
    Pause 1500
    comControl.Output = "ATH0" + vbCrLf

    `Close down communications
    comControl.PortOpen = False
End Sub

Private Sub Pause(dblMillisec As Double)
    Dim sngEndOfPause As Single
    `Determine end time of delay
    sngEndOfPause = Timer + dblMillisec / 1000
    `Loop away time
    Do
    Loop While Timer < sngEndOfPause
End Sub

Private Sub SetTime(strA As String)
    Dim intHo As Integer
    Dim intMi As Integer
    Dim intSe As Integer
    Dim dblTimeNow As Double
    `Extract current hour from system
    intHo = Hour(Now)
    `Extract minute and second from NIST string
    intMi = Val(Mid(strA, 22, 2))
    intSe = Val(Mid(strA, 25, 2))
    `Construct new time
    dblTimeNow = TimeSerial(intHo, intMi, intSe)
    `Set system clock
    Time = Format(dblTimeNow, "hh:mm:ss")
End Sub

Private Sub tmrGetBytes_Timer()
    Static blnConnect As Boolean
    Dim strTmp As String
    Dim intBytes As Integer
    Dim intP1 As Integer

    Dim intP2 As Integer
    `Check for incoming bytes
    If comControl.InBufferCount = 0 Then
        Exit Sub
    Else
        strTmp = comControl.Input
        intBytes = Len(strTmp)
        If intBytes + intNistNdx >= BUFSIZ Then
            lblInformation.Caption = "Hanging up"
            tmrGetBytes.Enabled = False
            tmrWatchDog.Enabled = False
            Unload Me
        Else
            Mid(strNistBuf, intNistNdx + 1, intBytes) = strTmp
            intNistNdx = intNistNdx + intBytes
        End If
    End If
    `Check for sign that we've connected
    If blnConnect = False Then
        If InStr(strNistBuf, "*" & vbCrLf) Then
            lblInformation.Caption = "Connected. Setting clock"
            blnConnect = True
        End If
    Else
        `Check for time marks
        intP1 = InStr(strNistBuf, "*")
        intP2 = InStr(intP1 + 1, strNistBuf, "*")
        `Time received if two time marks found
        If intP2 > intP1 Then
            SetTime Mid(strNistBuf, intP1, intP2 - intP1 + 1)
            Unload Me
        End If
    End If
End Sub

Private Sub tmrWatchDog_Timer()
    `Activate safety timeout if no connection
    Beep
    Unload Me
End Sub