Полный текст программы «Будильник-секундомер»
Привожу полный текст программы «Будильник-секундомер». В том, что касается будильника, я добавил упоминавшуюся мной процедуру Включить_звонок, причем включил в нее для привлечения внимания пользователя разворачивание будильника на весь экран. Везде, где можно, я объявления переменных перенес из верхней части окна кода внутрь процедур.
Public Class Form1
Inherits System.Windows.Forms.Form
Windows Form Designer generated code
Enum Режим
считает
пауза
в_нуле
End Enum
Dim Режим_секундомера As Режим
Dim Будильник_установлен As Boolean
Dim Секунды_на_секундомере As Double
Dim Секунды_при_запуске_секундомера As Double
Dim Секунды_на_паузе_секундомера As Double
'НАЧАЛЬНАЯ УСТАНОВКА МЕХАНИЗМА
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Настройка_звонка()
Выключить_будильник()
Смена_даты_и_дня_недели()
Секундомер_обнулить()
End Sub
'ПРОЦЕДУРЫ РАБОТЫ ЧАСОВ И БУДИЛЬНИКА
Private Sub Таймер_часов_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles Таймер_часов.Tick
Dim Время_на_часах As String
Время_на_часах = Format(Now, "HH:mm:ss")
Циферблат_часов.Text = Время_на_часах
If Время_на_часах = "00:00:00" Then Смена_даты_и_дня_недели()
If Будильник_установлен And Время_на_часах = Циферблат_будильника.Text Then Включить_звонок()
End Sub
Sub Смена_даты_и_дня_недели()
Циферблат_даты.Text = Format(Now, "Long Date")
Циферблат_дня_недели.Text = Format(Now, "dddd")
End Sub
Private Sub Кнопка_включения_выключения_будильника_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Кнопка_включения_выключения_будильника.Click
If Будильник_установлен Then Выключить_будильник() Else Включить_будильник()
End Sub
Sub Включить_будильник()
Будильник_установлен = True
Метка_будильника.Text = "Будильник установлен на"
Кнопка_включения_выключения_будильника.Text = "Выключить будильник"
End Sub
Sub Выключить_будильник()
Будильник_установлен = False
Метка_будильника.Text = "Будильник отключен"
Кнопка_включения_выключения_будильника.Text = "Включить будильник"
End Sub
Sub Настройка_звонка()
Звонок.AutoStart = False
Звонок.PlayCount = 0
Звонок.FileName = "Mozart's Symphony No. 40.RMI"
End Sub
Sub Включить_звонок()
Me.WindowState = FormWindowState.Maximized
Звонок.CurrentPosition = 0
Звонок.Play()
End Sub
Private Sub Кнопка_выключения_звонка_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Кнопка_выключения_звонка.Click
Звонок.Stop()
End Sub
'ПРОЦЕДУРЫ РАБОТЫ СЕКУНДОМЕРА
Private Sub Таймер_секундомера_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Таймер_секундомера.Tick
Dim Время_на_секундомере As Date
Const Полночь As Date = #12:00:00 AM#
Секунды_на_секундомере = DateAndTime.Timer - Секунды_при_запуске_секундомера + _
Секунды_на_паузе_секундомера
Время_на_секундомере = Полночь.AddSeconds(Секунды_на_секундомере)
Циферблат_секундомера.Text = Format(Время_на_секундомере, "mm:ss.ff")
End Sub
Private Sub Кнопка_пуска_паузы_секундомера_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Кнопка_пуска_паузы_секундомера.Click
If Режим_секундомера <> Режим_секундомера.считает Then Секундомер_запустить() _
Else Секундомер_остановить()
End Sub
Sub Секундомер_запустить()
Секунды_при_запуске_секундомера = DateAndTime.Timer
Режим_секундомера = Режим.считает
Таймер_секундомера.Enabled = True
Кнопка_пуска_паузы_секундомера.Text = "ПАУЗА"
End Sub
Sub Секундомер_остановить()
Секунды_на_паузе_секундомера = Секунды_на_секундомере
Режим_секундомера = Режим.пауза
Таймер_секундомера.Enabled = False
Кнопка_пуска_паузы_секундомера.Text = "ПУСК"
End Sub
Private Sub Кнопка_обнуления_секундомера_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Кнопка_обнуления_секундомера.Click
Секундомер_обнулить()
End Sub
Sub Секундомер_обнулить()
Секунды_на_паузе_секундомера = 0
Циферблат_секундомера.Text = "00:00.00"
Режим_секундомера = Режим.в_нуле
Таймер_секундомера.Enabled = False
Кнопка_пуска_паузы_секундомера.Text = "ПУСК"
End Sub
'ПРОЦЕДУРЫ ПОСТРОЕНИЯ БОРДЮРОВ
Private Sub Form1_Paint( ByVal sender As Object, ByVal e As PaintEventArgs) Handles MyBase.Paint
Бордюр_вокруг(Часы, Color.Blue, 20)
Бордюр_вокруг(Будильник, Color.Red, 20)
Бордюр_вокруг(Секундомер, Color.Green, 20)
End Sub
Sub Бордюр_вокруг(ByVal Объект As Control, ByVal Цвет As Color, ByVal Толщина As Single)
Dim Гр As Graphics = Me.CreateGraphics
Dim Т1 As New Point(0, 0)
Dim Т2 As New Point(430, 430)
Dim Кисть_град As New System.Drawing.Drawing2D.LinearGradientBrush(Т1, Т2, Цвет, Color.Yellow)
'Бордюр - залитый градиентом прямоугольник:
Гр.FillRectangle(Кисть_град, Объект.Left - Толщина, Объект.Top - Толщина, _
Объект.Width + 2 * Толщина, Объект.Height + 2 * Толщина)
'Черный ободок вокруг бордюра:
Гр.DrawRectangle(Pens.Black, Объект.Left - Толщина, Объект.Top - Толщина, _
Объект.Width + 2 * Толщина, Объект.Height + 2 * Толщина)
End Sub
End Class
