Главная страница Случайная страница
Разделы сайта
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Для новых пользователей первый месяц бесплатно. Чат-бот для мастеров и специалистов, который упрощает ведение записей: — Сам записывает клиентов и напоминает им о визите;
— Персонализирует скидки, чаевые, кэшбэк и предоплаты;
— Увеличивает доходимость и помогает больше зарабатывать; Начать пользоваться сервисом
Решение заданий
|
|
1.
Private Sub Квадрат_Click()
Результат.Text = Val(Число1.Text) * Val(Число1.Text)
End Sub
2.
Private Sub СБРОС_Click()
Число1.Text = " "
Число2.Text = " "
Результат.Text = " "
End Sub
5.
Private Sub Кл_вычитания_Click()
Результат.Text = Val(Число1.Text) - Val(Число2.Text)
Кл_вычитания.Left = 2000
Кл_вычитания.Caption = " Ой! "
End Sub
Private Sub СБРОС_Click()
Число1.Text = " "
Число2.Text = " "
Результат.Text = " "
Кл_вычитания.Left = 3400
Кл_вычитания.Caption = " -"
End Sub
6.
7.
Будет напечатано число 211.
8.
· 1001
· -100
· 15 -10
9.
10.
Dim a As Long
Dim b As Long
Private Sub Command1_Click()
a = 9000000
b = 1000
b = b + a
Debug.Print b
End Sub
11.
'Задача вычисления средней скорости
Dim Скорость1 As Double 'Скорость автомобиля на первом участке пути
Dim Время1 As Double 'Время прохождения первого участка
Dim Путь1 As Double 'Длина первого участка
Dim Скорость2 As Double 'Скорость автомобиля на втором участке пути
Dim Время2 As Double 'Время прохождения второго участка
Dim Путь2 As Double 'Длина второго участка
Dim Средняя_скорость As Double 'Средняя скорость автомобиля
Private Sub Command1_Click()
'Задание исходных данных
Скорость1 = 80
Время1 = 3
Скорость2 = 90
Время2 = 2
'Вычисление результата
Путь1 = Скорость1 * Время1
Путь2 = Скорость2 * Время2
Средняя_скорость = (Путь1 + Путь2) / (Время1 + Время2)
'Отображение результата
Debug.Print Средняя_скорость
End Sub
12.
'Задача: В самом углу прямоугольного двора стоит прямоугольный дом.
'Подсчитать площадь дома, свободную площадь двора и длину забора.
'Объявляем переменные величины
Dim Длина_двора As Integer
Dim Ширина_двора As Integer
Dim Площадь_двора As Integer
Dim Периметр_двора As Integer
Dim Длина_дома As Integer
— Регулярная проверка качества ссылок по более чем 100 показателям и ежедневный пересчет показателей качества проекта.
— Все известные форматы ссылок: арендные ссылки, вечные ссылки, публикации (упоминания, мнения, отзывы, статьи, пресс-релизы).
— SeoHammer покажет, где рост или падение, а также запросы, на которые нужно обратить внимание.
SeoHammer еще предоставляет технологию Буст, она ускоряет продвижение в десятки раз, а первые результаты появляются уже в течение первых 7 дней. Зарегистрироваться и Начать продвижение
Dim Ширина_дома As Integer
Dim Площадь_дома As Integer
Dim Полпериметра_дома As Integer
Dim Свободная_площадь_двора As Integer
Dim Длина_забора As Integer
Private Sub Command1_Click()
'Ввод исходных данных
Длина_двора = InputBox(" Введите длину двора")
Ширина_двора = InputBox(" Введите ширину двора")
Длина_дома = InputBox(" Введите длину дома")
Ширина_дома = InputBox(" Введите ширину дома")
'Вычисление результатов
Площадь_двора = Длина_двора * Ширина_двора
Площадь_дома = Длина_дома * Ширина_дома
Периметр_двора = 2 * (Длина_двора + Ширина_двора)
Полпериметра_дома = Длина_дома + Ширина_дома
Свободная_площадь_двора = Площадь_двора - Площадь_дома
Длина_забора = Периметр_двора - Полпериметра_дома
'Отображение результатов
Text1.Text = Площадь_дома
Text2.Text = Свободная_площадь_двора
Text3.Text = Длина_забора
End Sub
13.
'Задача вычисления длины окружности и площади круга
Dim R As Double 'Радиус
Dim L As Double 'Длина окружности
Dim S As Double 'Площадь круга
Dim Pi As Double 'Число " пи", равное 3, 14
Private Sub Command1_Click()
'Задание исходных данных
R = Text1.Text 'Величину радиуса берем из текстового поля
Pi = 3.1416
'Вычисление результатов
L = 2 * Pi * R
S = Pi * R ^ 2
'Отображение результатов с 5 знаками после запятой
Print " Длина окружности ="; Format(L, " 0.00000")
Print " Площадь круга ="; Format(S, " 0.00000")
End Sub
14.
Dim nazvanie1 As String 'Название первой планеты
Dim nazvanie2 As String 'Название второй планеты
Dim r1 As Double 'Радиус орбиты первой планеты
Dim r2 As Double 'Радиус орбиты второй планеты
Dim v1 As Double 'Скорость первой планеты
Dim v2 As Double 'Скорость второй планеты
Dim t1 As Double 'Продолжительность года первой планеты
Dim t2 As Double 'Продолжительность года второй планеты
Dim Pi As Double 'Число " пи", равное 3, 14
Private Sub Command1_Click()
'Задание исходных данных
nazvanie1 = InputBox(" Введите название первой планеты")
r1 = InputBox(" Введите радиус орбиты первой планеты (в миллионах километров)")
v1 = InputBox(" Введите скорость первой планеты (в миллионах километров в сутки)")
nazvanie2 = InputBox(" Введите название второй планеты")
r2 = InputBox(" Введите радиус орбиты второй планеты (в миллионах километров)")
v2 = InputBox(" Введите скорость второй планеты (в миллионах километров в сутки)")
— Разгрузит мастера, специалиста или компанию;
— Позволит гибко управлять расписанием и загрузкой;
— Разошлет оповещения о новых услугах или акциях;
— Позволит принять оплату на карту/кошелек/счет;
— Позволит записываться на групповые и персональные посещения;
— Поможет получить от клиента отзывы о визите к вам;
— Включает в себя сервис чаевых.
Для новых пользователей первый месяц бесплатно. Зарегистрироваться в сервисе
Pi = 3.1416
'Вычисление результатов
t1 = 2 * Pi * r1 / v1 'год = время 1 оборота = длина орбиты / скорость,
t2 = 2 * Pi * r2 / v2 'а длина орбиты равна два пи * радиус
'Отображение результатов в двух вариантах:
Print " Продолжительность года на планете "; nazvanie1; " - "; Format(t1, " 0"); _
" суток, а на планете "; nazvanie2; " - "; Format(t2, " 0"); " суток"
Text1.Text = " Продолжительность года на планете " + nazvanie1 + " - " + Format(t1, " 0") _
+ " суток, а на планете " + nazvanie2 + " - " + Format(t2, " 0") + " суток"
End Sub
15.
16.
17.
18.
Dim a As Double
Dim b As Double
Private Sub Command1_Click()
a = InputBox(" Введите первое число")
b = InputBox(" Введите второе число")
If a > b Then Debug.Print a + b Else Debug.Print a * b
Debug.Print " ЗАДАЧА РЕШЕНА"
End Sub
19.
Dim a As Double, b As Double, c As Double
Private Sub Command1_Click()
a = InputBox(" Введите первый отрезок")
b = InputBox(" Введите второй отрезок")
c = InputBox(" Введите третий отрезок")
If a < b + c Then Debug.Print " Достаточно мал" Else Debug.Print " Слишком велик"
End Sub
20.
Dim N As Integer, Число_голов As Integer, Число_глаз As Integer
Private Sub Command1_Click()
N = InputBox(" Введите возраст дракона")
If N < 100 Then Число_голов = 3 * N Else Число_голов = 300 + 2 * (N - 100)
Число_глаз = 2 * Число_голов
Debug.Print Число_голов, Число_глаз
End Sub
21.
Private Sub Command1_Click()
If Command1.Top < 300 Then Command1.Top = Command1.Top + 200
End Sub
22.
Dim k As Integer
Private Sub Command1_Click()
Command1.Left = (Form1.Width - 100) * Rnd
Command1.Top = (Form1.Height - 500) * Rnd
k = k + 1
Debug.Print k
End Sub
23.
Dim Загаданное_число As Integer, Отгаданное_число As Integer
Private Sub Command1_Click()
Загаданное_число = Int(2 * Rnd)
Отгаданное_число = InputBox(" Загадано число - 0 или 1. Отгадайте! ")
If Загаданное_число = Отгаданное_число Then Debug.Print " Угадал" Else Debug.Print " Не угадал"
End Sub
24.
Private Sub Command1_Click()
Имя = InputBox(" Как вас зовут? ")
If Имя = " Коля" Then
MsgBox (" Привет! ")
ElseIf Имя = " Вася" Then
Form1.BackColor = vbGreen
MsgBox (" Здорово! ")
ElseIf Имя = " John" Then
MsgBox (" Hi! ")
Else
MsgBox (" Здравствуйте! ")
End If
End Sub
25.
Dim imya As String
Dim vozrast As Integer
Private Sub Command1_Click()
Print " Здравствуй, я компьютер, а тебя как зовут? "
imya = InputBox(" Жду ответа")
Print " Очень приятно, "; imya; ". Сколько тебе лет? "
vozrast = InputBox(" Жду ответа")
Print " Ого! Целых"; vozrast; " лет! Ты уже совсем взрослый! "
If vozrast > 17 Then
InputBox (" В каком институте ты учишься? ")
Print " Хороший институт"
Else
InputBox (" В какой школе ты учишься? ")
Print " Неплохая школа"
End If
Print " До следующей встречи! "
End Sub
26.
Dim a As Double, b As Double, c As Double
Private Sub Command1_Click()
a = InputBox(" Введите первый отрезок")
b = InputBox(" Введите второй отрезок")
c = InputBox(" Введите третий отрезок")
If a > b + c Then
Debug.Print " Треугольника не получится"
ElseIf b > a + c Then
Debug.Print " Треугольника не получится"
ElseIf c > a + b Then
Debug.Print " Треугольника не получится"
Else
Debug.Print " Треугольник получится"
End If
End Sub
27.
Замысловатой принцессе нравятся черноглазые, кроме тех, чей рост находится в пределах от 180 до 184.
28.
Private Sub Command1_Click()
a = InputBox(" Введите дальность выстрела")
If a > 28 And a < 30 Then
MsgBox (" ПОПАЛ")
ElseIf a > = 30 Then
MsgBox (" ПЕРЕЛЕТ")
ElseIf a > = 0 And a < = 28 Then
MsgBox (" НЕДОЛЕТ")
Else
MsgBox (" НЕ БЕЙ ПО СВОИМ")
End If
End Sub
29.
Dim a As String 'Приветствие человека
Dim b As String 'Ответ компьютера
Private Sub Command1_Click()
a = InputBox(" Компьютер Вас слушает")
If a = " Привет" Or a = " Здравствуйте" Or a = " Салют" Then
b = a
ElseIf a = " Добрый день" Or a = " Приветик" Then
b = " Салют"
ElseIf a = " Здравия желаю" Then
b = " Вольно"
Else
b = " Я вас не понимаю"
End If
MsgBox (b)
End Sub
30.
Dim Буква As String
Private Sub Command1_Click()
Буква = InputBox(" Введите строчную букву русского алфавита")
Select Case Буква
Case " а", " и", " о", " у", " ы", " э"
Print " гласный"
Case " б", " з", " в", " г", " д", " ж", " й", " л", " м", " н", " р"
Print " согласный звонкий"
Case " п", " с", " ф", " к", " т", " ш", " х", " ц", " ч", " щ"
Print " согласный глухой"
Case " е", " ё", " ю", " я", " ъ", " ь"
Print " какой-нибудь другой, не знаю"
Case Else
Print " Это не строчная буква русского алфавита"
End Select
End Sub
32.
Считаем зайцев
10 зайцев
10 зайцев
11 зайцев
13 зайцев
16 зайцев
20 зайцев
25 зайцев
33.
5 Debug.Print " А";
GoTo 5
34.
a = 10000
5 Debug.Print a
a = a - 1
GoTo 5
35.
a = 100
5 Debug.Print Format(a, " 0.00000000")
a = a / 2
GoTo 5
36.
Процедура движения налево отличается от процедуры движения направо одной строкой:
m1: x = x - 0.01 'Компьютер уменьшает горизонтальную координату
Процедура движения вниз:
Private Sub Command3_Click()
y = Image1.Top 'Компьютер узнает, откуда начинать движение
m1: y = y + 0.01 'Компьютер увеличивает вертикальную координату
Image1.Top = y 'Изображение встает на место, указанное верт. координатой
GoTo m1
End Sub
Процедура движения вверх отличается от процедуры движения вниз одной строкой:
m1: y = y - 0.01 'Компьютер уменьшает вертикальную координату
В.
Private Sub Command1_Click()
'Печатаем 1 2 3 4... 100:
a = 1
m1: Debug.Print a;
a = a + 1
If a < = 100 Then GoTo m1
'Печатаем 99 98 97 96... 1:
a = 99
m2: Debug.Print a;
a = a - 1
If a > = 1 Then GoTo m2
End Sub
38.
Dim a As Double
Private Sub Command1_Click()
a = 0
m: Debug.Print Format(a, " 0.000"), Format(a ^ 2, " 0.000000")
a = a + 0.001
If a < = 1.00001 Then GoTo m
End Sub
Почему я вместо If a< =1 написал If a< =1.00001? Причина в незначительных погрешностях, которые допускает компьютер при действиях с десятичными дробями (о чем я писал в 4.5). На моем компьютере при многократном прибавлении 0.001 значение a на некотором этапе перестало быть точным. Конкретнее, у меня получилось вот что:
0, 682 + 0, 001 = 0, 683000000000001
Вследствие этого, при дальнейшем нарастании а последнее сложение было таким:
0, 999000000000001 + 0, 001 = 1, 000000000000001
Легко видеть, что в этом случае для a=1 задание не было бы выполнено, так как компьютер вышел бы из цикла раньше срока.
39.
Private Sub Command1_Click()
x = 2700
m1: y = x / 4 + 20
z = 2 * y + 0.23
If y * z < 1 / x Then GoTo m2
Debug.Print Format(x, " 0.000000"), Format(y, " 0.000000"), Format(z, " 0.000000")
x = x / 3
GoTo m1
m2:
End Sub
40.
x = 300
m1: x = x + 0.01
Image1.Left = x
If x < = 2000 Then GoTo m1
41.
Private Sub Command2_Click()
'Ставим объект в начальную точку:
x = 300
Image1.Left = x
y = 1000
Image1.Top = y
'Движемся направо:
m1: x = x + 0.01
Image1.Left = x
If x < = 2000 Then GoTo m1
'Движемся вниз:
m2: y = y + 0.01
Image1.Top = y
If y < = 1500 Then GoTo m2
End Sub
42.
Dim Slovo As String
Dim i As Integer
Private Sub Command1_Click()
i = 1
Do
Slovo = InputBox(" Введите слово")
Debug.Print i; Slovo; "! "
i = i + 1
Loop Until Slovo = " Хватит"
Debug.Print " Хватит так хватит"
End Sub
43.
Dim a As Double
Private Sub Command1_Click()
a = 0
Do
Debug.Print Format(a, " 0.000"), Format(a ^ 2, " 0.000000")
a = a + 0.001
Loop While a < = 1.00001
End Sub
44.
Private Sub Command2_Click()
x = 300
Image1.Left = x
y = 1000
Image1.Top = y
'Движемся направо:
Do
x = x + 0.01
Image1.Left = x
Loop While x < = 2000
'Движемся вниз:
Do
y = y + 0.01
Image1.Top = y
Loop Until y > 1500
End Sub
45.
v = 20: t = 0: h = 100: s = 0
Do
s = v * t
h = 100 - 9.81 * t ^ 2 / 2
Debug.Print Format(t, " 0.0"), s, Format(h, " 0.000")
t = t + 0.2
Loop Until h < 0
46.
Private Sub Command1_Click()
Debug.Print " Прямой счет: ";
For i = -5 To 5
Debug.Print i;
Next
Debug.Print " Обратный счет: ";
For i = 5 To -5 Step -1
Debug.Print i;
Next
Debug.Print " Конец счета"
End Sub
47.
N = InputBox(" Сколько всего кубиков? ")
For i = 1 To N
a = InputBox(" Введите сторону кубика")
V = a ^ 3 ' Объем кубика
Debug.Print " Сторона кубика ="; a, " Объем кубика ="; V
Next i
48.
Компьютер спросит размеры только одного зала и три раза напечатает его площадь и объем:
Площадь пола= 300 Объем зала= 1200
Площадь пола= 300 Объем зала= 1200
Площадь пола= 300 Объем зала= 1200
49.
Компьютер напечатает результаты только для последнего зала:
Площадь пола= 50 Объем зала= 150
50.
1) Компьютер напечатает результат, на 10 превышающий правильный
2) Компьютер напечатает результат, в 2 раза превышающий правильный
3) Компьютер напечатал бы 200 нарастающих значений счетчика
4) Компьютер напечатает 1, если последнее число положительное, и 0 - если неположительное
5) Компьютер запросит только одно число и напечатает 200, если оно положительное, и 0 - если неположительное
51.
c_полож = 0 'Обнуляем счетчик положительных чисел
c_отриц = 0 'Обнуляем счетчик отрицательных чисел
c_больше_10 = 0 'Обнуляем счетчик чисел, превышающих 10
N = InputBox(" Сколько всего чисел? ")
For i = 1 To N
a = InputBox(" Введите очередное число")
If a > 0 Then c_полож = c_полож + 1
If a < 0 Then c_отриц = c_отриц + 1
If a > 10 Then c_больше_10 = c_больше_10 + 1
Next i
Debug.Print " Из них положительных -"; c_полож; ", отрицательных -"; c_отриц; _
", чисел, превышающих десятку -"; c_больше_10
52.
Dim a As Double, b As Double
Private Sub Command4_Click()
c = 0 'Обнуляем счетчик пар
Do
a = InputBox(" Введите первое число пары")
b = InputBox(" Введите второе число пары")
If a = 0 And b = 0 Then Exit Do
If a + b = 13 Then c = c + 1
Loop
Debug.Print c
End Sub
53.
1) 18
2) 10
3) 5 и 8
4) 3
5) 10
6) 3
7) 5
54.
s = 0 'Обнуляем сумматор площади пола
For i = 1 To 40
Dlina = InputBox(" Введите длину")
Shirina = InputBox(" Введите ширину")
s = s + Dlina * Shirina 'Наращиваем сумматор площади пола
Next i
Debug.Print " Общая площадь пола="; s
55.
N = InputBox(" Сколько учеников в классе? ")
s = 0 'Обнуляем сумматор баллов
For i = 1 To N
Балл = InputBox(" Введите оценку по физике")
s = s + Балл 'Наращиваем сумматор баллов
Next i
Debug.Print " Средний балл по физике ="; Format(s / N, " 0.000")
56.
N = InputBox(" Сколько сомножителей? ")
proizv = 1 'Cумматор обнуляем, а накопитель произведения приравниваем 1. Почему?
For i = 1 To N
Число = InputBox(" Введите очередной сомножитель")
proizv = proizv * Число 'Наращиваем произведение
Next i
Debug.Print " Произведение равно"; proizv
57.
1)
For k = 3 To 8
For l = 0 To 7
Debug.Print k; l
Next l
Next k
2)
For k = 1 To 3
For l = 1 To 3
For m = 1 To 3
For n = 1 To 3
Debug.Print k; l; m; n
Next n
Next m
Next l
Next k
3)
i = 0 'Обнуляем счетчик
For k = 1 To 3
For l = 1 To 3
For m = 1 To 3
For n = 1 To 3
i = i + 1
Next n
Next m
Next l
Next k
Debug.Print i
4)
i = 0 'Обнуляем счетчик
For k = 1 To 3
For l = 1 To 3
For m = 1 To 3
For n = 1 To 3
If k < = l And l < = m And m < = n Then i = i + 1: Debug.Print k; l; m; n
Next n
Next m
Next l
Next k
Debug.Print i
58.
N = InputBox(" Сколько чисел? ")
Min = InputBox(" Введите число")
Номер_мин_числа = 1
For i = 2 To N
chislo = InputBox(" Введите число")
If chislo < Min Then Min = chislo: Номер_мин_числа = i
Next i
Debug.Print Min, Номер_мин_числа
59.
Dim N As Integer, Min As Integer, Max As Integer, Рост As Integer
Private Sub Command1_Click()
N = InputBox(" Сколько одноклассников? ")
Min = 500 'Заведомо невозможно огромный рост
Max = 0 'Заведомо ничтожный рост
For i = 1 To N
Рост = InputBox(" Введите рост")
If Рост < Min Then Min = Рост
If Рост > Max Then Max = Рост
Next i
If Max - Min > 40 Then Debug.Print " Правда" Else Debug.Print " Неправда"
End Sub
60.
'На форме Form1 ближе к краю размещены два маленьких объекта-" кнопки" Image1 и Image2
'с уже загруженными в них картинками, а также большой объект Image3.
Private Sub Image1_Click() 'ЧТО ДОЛЖНО ПРОИЗОЙТИ ПРИ ЩЕЛЧКЕ МЫШКОЙ ПО " КНОПКЕ" Image1:
Image3.Stretch = False 'Это чтобы большая " рамка" Image3 приняла форму и размеры картины
Image3.Visible = False 'А это чтобы большая картина не мелькала при преобразованиях Image3
Image3.Picture = Image1.Picture 'Копируем картинку с " кнопки" в большую " рамку"
Image1.BorderStyle = 1 'А это чтобы мы видели, какую картинку уже смотрели
Form_Factor = Form1.Width / Form1.Height 'Это продолговатость формы
Image_Factor = Image3.Width / Image3.Height 'Это продолговатость " рамки" Image3, принявшей картинку
If Image_Factor > Form_Factor Then 'Если картинка продолговатей, чем форма, ТО...
Image3.Width = 0.9 * Form1.Width 'картинка, конечно, должна быть чуть поуже формы (на 1/10)
Image3.Left = 0.05 * Form1.Width 'а это для симметричности по горизонтали (на 1/20 от левого края)
Image3.Height = Image3.Width / Image_Factor 'А это чтобы не исказились пропорции картинки
Image3.Top = (Form1.Height - Image3.Height) / 2 'А это для симметричности по вертикали
Else 'ИНАЧЕ...
Image3.Height = 0.9 * Form1.Height 'Картинка, конечно, должна быть чуть покороче формы (на 1/10)
Image3.Top = 0.05 * Form1.Height 'А это для симметричности по вертикали (на 1/20 от верхнего края)
Image3.Width = Image3.Height * Image_Factor 'А это чтобы не исказились пропорции картинки
Image3.Left = (Form1.Width - Image3.Width) / 2 'А это для симметричности по горизонтали
End If
Image3.Stretch = True 'А это для того, чтобы картина приняла размеры " рамки" после ее успешных преобразований
Image3.Visible = True 'А вот теперь можно полюбоваться картиной
End Sub
Private Sub Image2_Click() 'ЧТО ДОЛЖНО ПРОИЗОЙТИ ПРИ ЩЕЛЧКЕ МЫШКОЙ ПО " КНОПКЕ" Image2:
Image3.Stretch = False
Image3.Visible = False
Image3.Picture = Image2.Picture
Image2.BorderStyle = 1
Form_Factor = Form1.Width / Form1.Height
Image_Factor = Image3.Width / Image3.Height
If Image_Factor > Form_Factor Then
Image3.Width = 0.9 * Form1.Width
Image3.Left = 0.05 * Form1.Width
Image3.Height = Image3.Width / Image_Factor
Image3.Top = (Form1.Height - Image3.Height) / 2
Else
Image3.Height = 0.9 * Form1.Height
Image3.Top = 0.05 * Form1.Height
Image3.Width = Image3.Height * Image_Factor
Image3.Left = (Form1.Width - Image3.Width) / 2
End If
Image3.Stretch = True
Image3.Visible = True
End Sub
61.
Private Sub Command1_Click()
BackColor = vbWhite 'красим форму в белый цвет
Circle (3300, 1200), 400 'голова
DrawWidth = 5 'увеличиваем толщину линий и точек
PSet (3450, 1100) 'глаз
PSet (3150, 1100) 'глаз
Line (3200, 1400)-(3400, 1400) 'pот
DrawWidth = 1 'возвращаем обычную толщину линий и точек
ForeColor = vbRed 'красный цвет линий и текста
Line (3300, 1200)-(3300, 1300) 'нос
Line (3300, 1200)-(3050, 1300) 'нос
Line (3300, 1300)-(3050, 1300) 'нос
ForeColor = vbBlack 'черный цвет линий и текста
Circle (3300, 2200), 600 'сеpедина
Line (3500, 1630)-(4550, 1830),, B 'pука
Line (2030, 1630)-(3080, 1830),, B 'pука
FillStyle = vbSolid 'приказ рисовать элементы со сплошной (vbSolid) заливкой
FillColor = vbYellow 'желтая заливка
Line (3000, 300)-(3600, 800),, B 'шапка
FillColor = RGB(220, 220, 220) 'серая заливка
Circle (3300, 3600), 800 'низ
DrawWidth = 3 'увеличиваем толщину линий и точек
ForeColor = vbBlue 'синий цвет линий и текста
Line (2200, 1300)-(1800, 4400) 'посох
Font = " Times" 'название шрифта
Font.Italic = True 'курсив
Font.Bold = True 'полужирный
Font.Size = 14 'размер шрифта
CurrentX = 2700 'координаты начала печати
CurrentY = 3300
Print " Снеговик"
CurrentX = 2830
Print " Ефрем"
End Sub
62.
Dim c As Long, R As Long, G As Long, B As Long
Private Sub Command1_Click()
x = InputBox(" Введите горизонтальную координату точки")
y = InputBox(" Введите вертикальную координату точки")
c = Point(x, y) 'Определяем код цвета заданной точки
R = c Mod 256 'Количество красного
BG = c \ 256 'Промежуточный результат
G = BG Mod 256 'Количество красного
B = BG \ 256 'Количество красного
Debug.Print c, R, G, B, " Проверка -"; B * 256 * 256 + G * 256 + R
'Следующие три строки - для проверки на глазок правильности определения R, G, B:
Circle (x, y), 200
DrawWidth = 20
PSet (x, y), RGB(R, G, B)
'Определяем, какого цвета больше - R, G или B:
If R > G And R > B Then
Debug.Print " Красного больше"
ElseIf G > R And G > B Then
Debug.Print " Зеленого больше"
ElseIf B > R And B > G Then
Debug.Print " Синего больше"
Else
Debug.Print " Два самых ярких или три цвета одинаково интенсивны"
End If
End Sub
63.
Программа отличается от той, что в разделе, одним числом:
x = x + 120
64.
Программа отличается от предыдущей двумя числами:
x = 200
Do Until x > 8000
65.
Вместо 100 пишем 200.
66.
Dim x As Long, y As Long
Private Sub Command1_Click()
x = 100
y = 6000
Do Until x > 9000
PSet (x, y)
x = x + 100
y = y - 60
Loop
End Sub
67.
x = 4000: y = 3000: R = 100
Do Until R > 2500
Circle (x, y), R
R = R + 100
Loop
68.
Private Sub Command3_Click()
BackColor = RGB(0, 0, 150)
ForeColor = vbYellow
'Компакт-диск:
x = 4000: y = 3000: R = 500
Do Until R > 2500
Circle (x, y), R
R = R + 20
Loop
'Летающая тарелка:
x = 10000: y = 3000: R = 500
Do Until R > 2500
Circle (x, y), R,,,, 1 / 2
R = R + 20
Loop
End Sub
69.
x = 4000: y = 500: R = 0
Do Until R > 2500
Circle (x, y), R,,,, 1 / 2
R = R + 50
y = y + 150
Loop
70.
x = 400: y = 500: R = 0
Do Until R > 1500
Circle (x, y), R
R = R + 20
y = y + 60
x = x + 120
Loop
71.
y = 0 'Разлиновывать начинаем с верхнего края формы
Do Until y > Height 'Разлиновываем до нижнего края формы
Line (0, y)-(Width, y) 'Линию проводим до правого края формы
y = y + 200 'Расстояние между линиями = 200
Loop
72.
Private Sub Command2_Click()
'Разлиновываем горизонтальными линиями:
y = 0 'Разлиновывать начинаем с верхнего края формы
Do Until y > Height 'Разлиновываем до нижнего края формы
Line (0, y)-(Width, y) 'Линию проводим до правого края формы
y = y + 200 'Расстояние между линиями = 200
Loop
'Разлиновываем вертикальными линиями:
x = 0 'Разлиновывать начинаем с левого края формы
Do Until x > Width 'Разлиновываем до правого края формы
Line (x, 0)-(x, Height) 'Линию проводим до нижнего края формы
x = x + 200 'Расстояние между линиями = 200
Loop
End Sub
73.
Private Sub Command3_Click()
'Разлиновываем горизонтальными линиями:
y = 0 'Разлиновывать начинаем с верхнего края формы
Do Until y > Height 'Разлиновываем до нижнего края формы
Line (0, y)-(Width, y) 'Линию проводим до правого края формы
y = y + 200 'Расстояние между линиями = 200
Loop
'Разлиновываем косыми линиями:
x = 0 'Разлиновывать начинаем с левого края формы
Do Until x > Width + 2000 'Разлиновываем до правого края формы с запасом в 2000
Line (x, 0)-(x - 2000, Height) 'Линию проводим наискосок до нижнего края формы
x = x + 200 'Расстояние между линиями = 200
Loop
End Sub
74.
x = 100 'Квадраты начинаем рисовать от левого края формы
Do Until x > 8000 'Рисуем их до координаты 8000
Line (x, 3000)-(x + 1000, 4000),, B 'Ширина квадрата = 1000, высота = 4000-3000
x = x + 1500 'Шаг рисования квадратов = 1500
Loop
75.
Dim x As Integer, y As Integer 'Координаты левого верхнего угла каждого из 64 квадратов
Dim i As Integer 'i - номер столбца на доске (от 1 до 8 слева направо)
Dim j As Integer 'j -номер строки на доске (от 1 до 8 сверху вниз)
Private Sub Command2_Click()
For j = 1 To 8 'Пробегаем 8 клеток по вертикали сверху вниз
For i = 1 To 8 'Пробегаем 8 клеток по горизонтали слева направо
x = 1000 * i
y = 1000 * j
'ЕСЛИ сумма номеров столбца и строки четная, то заливка квадрата синяя, ИНАЧЕ желтая:
If (i + j) Mod 2 = 0 Then Цвет_заливки = vbBlue Else Цвет_заливки = vbYellow
Line (x, y)-(x + 1000, y + 1000), Цвет_заливки, BF 'рисуем закрашенный квадрат,
Next i
Next j
End Sub
76.
Dim x As Integer, y As Integer 'Координаты центров окружностей
Private Sub Command1_Click()
y = 1000 'По вертикали ковер простирается от 1000 до 6000 твипов
Do Until y > = 6000
x = 1000 'По горизонтали ковер простирается от 1000 до 8000 твипов
Do Until x > = 8000
Circle (x, y), 300
x = x + 150 'Расстояние между центрами окружностей - 150 твипов
Loop
y = y + 150
Loop
End Sub
77.
Вместо строки
Circle (x, y), 300
пишем строку
If x > 2000 Or y < 5000 Then Circle (x, y), 300
78.
Вместо строки
Circle (x, y), 300
пишем строку
If (x > 2000 Or y < 5000) And Not (x > 4000 And x < 5000 And y > 3000 And y < 4000) Then Circle (x, y), 300
которую можно вольно перевести так:
ЕСЛИ (это не левый нижний угол) И НЕПРАВДА, что (это квадрат в центре), ТО рисуй кружок
79.
Line (2000, 1000)-(6000, 5500),, BF 'Черный прямоугольник окна
For i = 1 To 1000
DrawWidth = Round(2 * Rnd) + 1 'Толщина звезд = 1, 2, 3
PSet (2000 + 4000 * Rnd, 1000 + 4500 * Rnd), 16777216 * Rnd 'Откуда взялись числа 4000 и 4500? Вот откуда:
'4000=6000-2000, 4500=5500-1000
Next
80.
For i = 1 To 40
Circle (Width * Rnd, Height * Rnd), 200,,,, 1 / 2
Next
81.
Private Sub Command4_Click()
For i = 1 To 150
Circle (Width * Rnd, Height * Rnd), 1000 * Rnd, 16777216 * Rnd
Next
End Sub
82.
BackColor = vbBlack 'Черное небо
For i = 1 To 200000 'Большое число - чтобы долго рисовалось. Сам процесс приятен.
'Каждый луч прожектора - отрезок от центральной точки формы (Width / 2, Height / 2)
'до случайной (Width * Rnd, Height * Rnd):
Line (Width / 2, Height / 2)-(Width * Rnd, Height * Rnd), 16777216 * Rnd
Next
83.
For i = 1 To 1000
'Левая треть стога имеет горизонтальные координаты от 0 до 2000,
'значит случайная точка внутри этой части - (2000 * Rnd)
'Правая треть стога имеет горизонтальные координаты от 4000 до 6000,
'значит случайная точка внутри этой части - (4000 + 2000 * Rnd)
'Поскольку стог сделан из сена, то в его цвете преобладают красная и зеленая составляющие, а не синяя
Line (2000 * Rnd, 6000 * Rnd)-(4000 + 2000 * Rnd, 6000 * Rnd), RGB(100 + 156 * Rnd, 100 + 156 * Rnd, 40 * Rnd)
Next
84.
For i = 1 To 10000
Line (Width * Rnd, Height * Rnd)-(Width * Rnd, Height * Rnd), 16777216 * Rnd, BF
For j = 1 To 1000000: Next
Next
85.
Private Sub Command1_Click() 'Звездное небо с порцией из 400 звезд
BackColor = vbBlack
For i = 1 To 400
DrawWidth = 1 + Round(2 * Rnd)
PSet (Width * Rnd, Height * Rnd), 16777216 * Rnd
Next
End Sub
Private Sub Command2_Click() 'Летающая тарелка
Randomize
DrawWidth = 1
'Сначала подбираем случайный радиус внутреннего отверстия тарелки:
r0 = 500 * Rnd
'Теперь назначаем случайные координаты тарелки:
x = Width * Rnd
y = Height * Rnd
'Теперь начинаем рисовать саму тарелку - концентрические эллипсы
'с начальным радиусом r0 и конечным радиусом 4 * r0:
r = r0
Do Until r > 4 * r0
Circle (x, y), r, vbYellow,,, 1 / 2
r = r + 15
Loop
End Sub
86.
Private Sub Form_Load()
Звук.DeviceType = " WaveAudio"
Звук.FileName = " c: \Windows\Media\Chimes.wav"
End Sub
Private Sub Музыкальная_вставка() 'Это требуемая процедура пользователя
Звук.Command = " Open"
Звук.Command = " Sound"
Звук.Command = " Close"
End Sub
Private Sub Command1_Click()
Музыкальная_вставка
Picture1.Picture = LoadPicture(" c: \temp\Rockies.bmp")
End Sub
Private Sub Command2_Click()
Музыкальная_вставка
Picture1.Picture = LoadPicture(" c: \temp\Porthole.bmp")
End Sub
87.
Я, король Франции, спрашиваю вас - кто вы такие? Вот ты - кто такой?
Я - Атос
А ты, толстяк, кто такой?
А я Портос! Я правильно говорю, Арамис?
Это так же верно, как то, что я -Арамис!
Он не врет, ваше величество! Я Портос, а он Арамис.
А ты что отмалчиваешься, усатый?
А я все думаю, ваше величество - куда девались подвески королевы?
Анна! Иди-ка сюда!!!
88.
Private Sub Image1_Click()
Готовим_рамку_к_приему_фото
Image3.Picture = Image1.Picture
Image1.BorderStyle = 1
Увеличиваем_рамку_и_показываем_фото
End Sub
Private Sub Image2_Click()
Готовим_рамку_к_приему_фото
Image3.Picture = Image2.Picture
Image2.BorderStyle = 1
Увеличиваем_рамку_и_показываем_фото
End Sub
Private Sub Готовим_рамку_к_приему_фото()
Image3.Stretch = False
Image3.Visible = False
End Sub
Private Sub Увеличиваем_рамку_и_показываем_фото()
Form_Factor = Form1.Width / Form1.Height
Image_Factor = Image3.Width / Image3.Height
If Image_Factor > Form_Factor Then
Image3.Width = 0.9 * Form1.Width
Image3.Left = 0.05 * Form1.Width
Image3.Height = Image3.Width / Image_Factor
Image3.Top = (Form1.Height - Image3.Height) / 2
Else
Image3.Height = 0.9 * Form1.Height
Image3.Top = 0.05 * Form1.Height
Image3.Width = Image3.Height * Image_Factor
Image3.Left = (Form1.Width - Image3.Width) / 2
End If
Image3.Stretch = True
Image3.Visible = True
End Sub
90.
Dim Otstup As Integer 'Расстояние от края формы до центра окружностей
Dim Razmer As Integer 'Радиус самой большой окружности
Dim Tsvet As Long
Private Sub Рисуем_значок_друга()
Otstup = 300
Razmer = 200
Tsvet = vbRed
Picture1.Circle (Otstup, Otstup), Razmer * 1 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 2 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 3 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 4 / 4, Tsvet
End Sub
Private Sub Command3_Click()
Picture1.Picture = LoadPicture(" c: \temp\Balloons.bmp")
Рисуем_значок_друга
Picture1.Print, " 12.08.2001"
End Sub
91.
Private Sub Form_Load()
Звук.DeviceType = " WaveAudio"
End Sub
Private Sub Музыкальная_вставка(Звуковой_файл As String)
Звук.FileName = Звуковой_файл
Звук.Command = " Open"
Звук.Command = " Sound"
Звук.Command = " Close"
End Sub
Private Sub Command1_Click()
Музыкальная_вставка " c: \Windows\Media\Chimes.wav"
Picture1.Picture = LoadPicture(" c: \temp\Rockies.bmp")
End Sub
Private Sub Command2_Click()
Музыкальная_вставка " c: \Windows\Media\Tada.wav"
Picture1.Picture = LoadPicture(" c: \temp\Porthole.bmp")
End Sub
92.
Private Sub Рисуем_значок_друга(Otstup As Integer, Razmer As Integer, Tsvet As Long)
Picture1.Circle (Otstup, Otstup), Razmer * 1 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 2 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 3 / 4, Tsvet
Picture1.Circle (Otstup, Otstup), Razmer * 4 / 4, Tsvet
End Sub
Private Sub Command3_Click()
Picture1.Picture = LoadPicture(" c: \temp\Balloons.bmp")
Рисуем_значок_друга 300, 200, vbRed
Picture1.Print, " 12.08.2001"
End Sub
93.
Private Sub Крестик(x As Integer, y As Integer, Размер As Integer)
'Крестик - это 2 пересекающихся отрезка (Line)
Line (x, y + Размер / 2)-(x, y - Размер / 2)
Line (x + Размер / 2, y)-(x - Размер / 2, y)
End Sub
Private Sub Треугольник(x As Integer, y As Integer, Размер As Integer)
'Треугольник - это 3 отрезка (Line) с общими концами
'x и y - координаты левого нижнего угла треугольника
Line (x, y)-(x + Размер, y)
Line (x, y)-(x + Размер / 2, y - Размер)
Line (x + Размер, y)-(x + Размер / 2, y - Размер)
End Sub
Private Sub Command1_Click()
Крестик 4000, 2000, 400
Треугольник 3000, 1000, 800
End Sub
94.
Dim a As Integer, b As Integer
Private Sub Рисуем_срез(Выбор_цвета As Integer, Насыщенность As Integer)
Размер = 40 'Это длина стороны квадратика
For j = 0 To 255 'Внешний цикл - рисует строки квадратиков по вертикали сверху вниз
y = j * Размер 'Вертикальная координата строки квадратиков
For i = 0 To 255 'Внутренний цикл - рисует квадратики по горизонтали слева направо
x = i * Размер 'Горизонтальная координата квадратика
Select Case Выбор_цвета
Case 1
Line (x, y)-(x + Размер, y + Размер), RGB(Насыщенность, i, j), BF 'квадратик
Case 2
Line (x, y)-(x + Размер, y + Размер), RGB(i, Насыщенность, j), BF 'квадратик
Case 3
Line (x, y)-(x + Размер, y + Размер), RGB(i, j, Насыщенность), BF 'квадратик
End Select
Next i
Next j
End Sub
Private Sub Command1_Click()
a = InputBox(" Введите число 1, 2 или 3. Если фиксированный цвет красный, то 1, если зеленый - 2, синий -3")
b = InputBox(" Введите насыщенность фиксированного цвета - число от 0 до 255")
Рисуем_срез a, b
End Sub
a и b - неудачные имена, так как не говорят о смысле переменных. В будущем вы увидите, что можно было бы использовать уже применяющиеся имена - Выбор_цвета и Насыщенность.
95.
Private Sub Command1_Click()
Debug.Print DateAdd(" ww", 52, Date)
End Sub
96.
Private Sub Command2_Click()
Дата_рождения = InputBox(" Введите дату своего рождения")
Debug.Print DateDiff(" s", Дата_рождения, Now)
End Sub
97.
Private Sub Command3_Click()
Дата_рождения = InputBox(" Введите дату своего рождения")
'Переменная Сколько_мне_лет не совсем точно соответствует общепринятому смыслу.
'Это разность между текущим годом и годом рождения.
Сколько_мне_лет = DateDiff(" yyyy", Дата_рождения, Date)
День_рождения_в_этом_году = DateAdd(" yyyy", Сколько_мне_лет, Дата_рождения)
День_рождения_в_следующем_году = DateAdd(" yyyy", Сколько_мне_лет + 1, Дата_рождения)
If День_рождения_в_этом_году > = Date Then 'Если день рождения позже сегодняшнего числа
Сколько_дней_осталось = День_рождения_в_этом_году - Date
Else
Сколько_дней_осталось = День_рождения_в_следующем_году - Date
End If
Debug.Print Сколько_дней_осталось
End Sub
98.
Private Sub Command4_Click()
Текущая_дата = #1/1/1920#
Do Until Текущая_дата > #1/1/2940#
Дата_через_год = DateAdd(" yyyy", 1, Текущая_дата)
Число_дней_в_году = DateDiff(" y", Текущая_дата, Дата_через_год)
Год = DatePart(" yyyy", Текущая_дата)
If (Число_дней_в_году = 366) And Not (Год Mod 4 = 0) Then
Debug.Print " Лишний високосный год -"; Год, Число_дней_в_году
End If
Текущая_дата = Дата_через_год
Loop
End Sub
Эта программа отлавливает лишние високосные года (не кратные 4) между 1920 и 2940 годами.
99.
Dim k As Integer
Private Sub Form_Load()
k = 100
End Sub
Private Sub Timer1_Timer()
Debug.Print k
k = k + 1
If k > 110 Then Timer1.Enabled = False
End Sub
100.
Dim x As Integer, y As Integer, R As Integer 'Координаты и радиус колес и прямоугольника
Dim Цвет_фигуры As Long, Цвет_фона As Long
Private Sub Form_Load()
x = 1000: y = 1500: R = 200
DrawWidth = 5 'Толщина линии
Цвет_окружности = vbBlack
Цвет_фона = BackColor
End Sub
Private Sub Timer1_Timer()
Circle (x, y), R, Цвет_фигуры 'Рисуем одно колесо
Circle (x + 1000, y), R, Цвет_фигуры 'Рисуем другое колесо
Line (x - 300, y)-(x + 1300, y - 400), Цвет_фигуры, B 'Рисуем прямоугольник
For i = 1 To 500000: Next 'Пустой цикл
Circle (x, y), R, Цвет_фона 'Стираем одно колесо
Circle (x + 1000, y), R, Цвет_фона 'Стираем другое колесо
Line (x - 300, y)-(x + 1300, y - 400), Цвет_фона, B 'Стираем прямоугольник
x = x + 30 'Перемещаемся немного направо
End Sub
101.
Private Sub Timer1_Timer()
Shape1.Top = Shape1.Top - 20
Shape2.Top = Shape2.Top - 20
End Sub
102.
Private Sub Timer1_Timer()
Shape1.Top = Shape1.Top + 20
Shape2.Left = Shape2.Left + 20
End Sub
104.
Dim Шаг As Integer, x As Integer
Private Sub Form_Load()
x = Shape1.Left
Шаг = 50
End Sub
Private Sub Timer1_Timer()
x = x + Шаг
Shape1.Left = x
If x > Width - Shape1.Width Then Шаг = -50 'Если фигура улетела за правый край формы, то лететь обратно
If x < 0 Then Шаг = 50 'Если фигура улетела за левый край формы, то лететь обратно
End Sub
105.
Dim x As Integer, y As Integer, dx As Integer, dy As Integer
'dx - шаг шаpика по гоpизонтали,
'то есть pасстояние по гоpизонтали между двумя последовательными
'положениями шарика. dy - аналогично по веpтикали
Private Sub Form_Load()
Show 'Чтобы форма показалась на экране до рисования стола
Line (450, 450)-(6200, 4600),, B 'боpтики стола
x = Image1.Left: y = Image1.Top 'Hачальное положение шаpика
dx = 40: dy = 60 'Hапpавление движения - впpаво вниз
End Sub
Private Sub Timer1_Timer()
x = x + dx: y = y + dy 'Двигаем шарик
Image1.Left = x: Image1.Top = y 'Двигаем шарик
If x < 500 Or x > 5900 Then dx = -dx 'Удаpившись о левый или пpавый боpт,
'шаpик меняет гоpизонтальную составляющую скоpости на пpотивоположную
If y < 500 Or y > 4300 Then dy = -dy 'Удаpившись о веpхний или нижний боpт,
'шаpик меняет веpтикальную составляющую скоpости на пpотивоположную
'Если шаpик в левом веpхнем углу или в левом нижнем
'или в пpавом веpхнем или в пpавом нижнем, то останавливай шаpик:
If (x < 800 And y < 800) Or (x < 800 And y > 4000) _
Or (x > 5600 And y < 800) Or (x > 5600 And y > 4000) Then Timer1.Enabled = False
End Sub
106.
Dim x As Long, y As Long, x0 As Long, y0 As Long
Dim t As Double, s As Double, h As Double, v As Double
Private Sub Form_Load()
Timer1.Enabled = False
Show
AutoRedraw = True
Line (200, 400)-(400, 4400),, B 'башня
Line (0, 4400)-(6400, 4400) 'земля
x0 = 400: y0 = 400 'Кооpдинаты веpха башни
v = 20: t = 0 'Hачальные скоpость и вpемя
Image1.Left = x0: Image1.Top = y0 'Начальное положение камня
End Sub
Private Sub Command1_Click() 'Бросаем камень
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
s = 40 * v * t: h = 40 * (100 - 9.81 * t ^ 2 / 2)
x = x0 + Round(s): y = y0 + (4000 - Round(h)) 'Кооpдинаты камня в полете
Image1.Left = x: Image1.Top = y
PSet (x, y) 'След камня в полете
t = t + 0.1
If h < 0 Then Timer1.Enabled = False 'Если камень упал, время останавливается
End Sub
108.
Private Sub Timer1_Timer()
Label1.FontSize = Label1.FontSize + 1
Label1.ForeColor = Label1.ForeColor + 10
End Sub
110-111.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then PSet (X, Y) 'Если левая клавиша мыши нажата, то рисуем
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then DrawWidth = DrawWidth + 1 'Если правая клавиша мыши нажата, то увеличиваем толщину линии
End Sub
112.
'В режиме проектирования поместим на форму прямоугольник и три круга.
'Назовем круги Красная_лампа, Желтая_лампа, Зеленая_лампа
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKey R
Красная_лампа.FillColor = vbRed
Желтая_лампа.FillColor = vbBlack
Зеленая_лампа.FillColor = vbBlack
Case vbKey Y
Красная_лампа.FillColor = vbBlack
Желтая_лампа.FillColor = vbYellow
Зеленая_лампа.FillColor = vbBlack
Case vbKey G
Красная_лампа.FillColor = vbBlack
Желтая_лампа.FillColor = vbBlack
Зеленая_лампа.FillColor = vbGreen
End Select
End Sub
113.
'В режиме проектирования поместим на форму два Image и два таймера.
'Назовем их Самолет, Снаряд, Таймер_самолета, Таймер_снаряда
Private Sub Form_Load()
Таймер_снаряда.Enabled = False
End Sub
Private Sub Таймер_самолета_Timer()
Самолет.Left = Самолет.Left - 20
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Таймер_снаряда.Enabled = True
End Sub
Private Sub Таймер_снаряда_Timer()
Снаряд.Top = Снаряд.Top - 50
End Sub
115.
1) a(i) = a(i-1) + 4
2) a(i) = 2 * a(i-1)
3) a(i) = 2 * a(i-1) - 1
116-118.
Dim t(1 To 7) As Integer
Private Sub Command1_Click()
t(1) = 8: t(2) = 14: t(3) = 19: t(4) = 22: t(5) = 25: t(6) = 28: t(7) = 26
'Определим среднегодовую температуру:
s = 0
For i = 1 To 7: s = s + t(i): Next
Debug.Print s / 7
'Определим количество теплых дней в году:
k = 0
For i = 1 To 7
If t(i) > 20 Then k = k + 1
Next
Debug.Print k
'Определим, каким по порядку идет самый жаркий день
Min = t(1): nomer = 1
For i = 2 To 7
If t(i) > Min Then Min = t(i): nomer = i
Next
Debug.Print nomer
End Sub
119.
Dim fib(1 To 70) As Currency
Private Sub Command1_Click()
fib(1) = 1: fib(2) = 1
For i = 3 To 70
fib(i) = fib(i - 2) + fib(i - 1)
Debug.Print i, fib(i)
Next
End Sub
120.
Dim t(1 To 3, 1 To 4) As Integer
Private Sub Command1_Click()
t(1, 1) = -8: t(1, 2) = -14: t(1, 3) = -19: t(1, 4) = -18
t(2, 1) = 25: t(2, 2) = 28: t(2, 3) = 26: t(2, 4) = 20
t(3, 1) = 11: t(3, 2) = 18: t(3, 3) = 20: t(3, 4) = 25
Min = t(1, 1): Max = t(1, 1)
For i = 1 To 3
For j = 1 To 4
If t(i, j) > Max Then Max = t(i, j)
If t(i, j) < Min Then Min = t(i, j)
Next j
Next i
Debug.Print Max - Min
End Sub
123.
Private Sub Form_Load()
Label_Минимальная.Caption = HScroll1.Min
Label_Максимальная.Caption = HScroll1.Max
Label_Текущая.Caption = HScroll1.Value
End Sub
Private Sub HScroll1_Change()
Label_Текущая.Caption = HScroll1.Value
End Sub
123-1.
Private Sub Combo1_Click()
Combo2.Text = Combo2.List(Combo1.ListIndex)
End Sub
124.
Я
125.
Private Sub Command1_Click() 'Шифруем слово из 6 букв
s = " Корова"
Debug.Print Mid(s, 1, 2) + " быр" + Mid(s, 3, 2) + " быр" + Mid(s, 5, 2) + " быр"
End Sub
Private Sub Command2_Click() 'Шифруем произвольное слово
s = " Консенсус"
For i = 1 To Len(s) \ 2 'Len(s) \ 2 - это число полных пар букв в слове
Debug.Print Mid(s, 2 * i - 1, 2) + " быр"; 'Печатаем очередную пару букв и " быр"
Next
'Допечатываем последнюю нечетную букву, если она есть:
If Len(s) Mod 2 = 1 Then Debug.Print Right(s, 1)
End Sub
126.
Dim s As String 'Исходная строка
Dim s1 As String 'Результирующая строка
Private Sub Command1_Click()
s = " Консенсус"
s1 = " " 'Результирующую строку строим с нуля
For i = 1 To Len(s) 'Просматриваем исходную строку слева направо
Старый_символ = Mid(s, i, 1) 'Выделяем очередной символ в исходной строке
If Старый_символ = " я" Then 'Букву я кодируем в букву а:
Новый_символ = " а"
Else 'остальные буквы кодируем, как задано в задаче:
Новый_символ = Chr(Asc(Старый_символ) + 1)
End If
s1 = s1 + Новый_символ 'Наращиваем результирующую строку на очередной символ
Next
Debug.Print s1 'Печатаем результат
End Sub
127.
Dim SecretNumber As Long 'Загаданное компьютером число
Dim A As Long 'Число - попытка человека
Dim Сообщение As String
Dim Количество_попыток As Integer
Private Sub Form_Load()
Выбор = MsgBox(" Продолжим старую игру? ", vbQuestion + vbYesNo)
If Выбор = vbYes Then Загружаем_сохраненную_игру Else Настраиваем_новую_игру
End Sub
Private Sub Настраиваем_новую_игру()
Randomize
SecretNumber = Round(1000000000 * Rnd) 'Компьютер загадывает число
txtNumber.Text = 0 'Текстовое поле для ввода человеком числа
txtMessage.Text = " Попыток не было" 'Текстовое поле для вывода компьютером сообщений
Количество_попыток = 0
txtNumberTry.Text = Количество_попыток 'Текстовое поле для вывода количества попыток
Open App.Path & " \Данные.txt" For Output As #1 'Открыть для записи под номером 1 файл Данные.txt из папки проекта
Write #1, SecretNumber 'Запись в файл загаданного числа
End Sub
Sub cmdTry_Click() 'Нажатие на кнопку попытки
A = Val(txtNumber.Text)
If A > SecretNumber Then 'В этом операторе If вся несложная логика игры
Сообщение = " Много"
ElseIf A < SecretNumber Then
Сообщение = " Мало"
Else
Сообщение = " Вы угадали"
End If
txtMessage.Text = Сообщение
Количество_попыток = Количество_попыток + 1
txtNumberTry.Text = Количество_попыток
Write #1, Количество_попыток; A; Сообщение 'Запись в файл данных очередной попытки
End Sub
Private Sub Загружаем_сохраненную_игру()
Open App.Path & " \Данные.txt" For Input As #1 'Открыть для чтения под номером 1 файл Данные.txt из папки проекта
Input #1, SecretNumber 'Чтение из файла загаданного числа
Show 'Чтобы на форме можно было печатать историю игры
Print " ИСТОРИЯ ИГРЫ"
Do While Not EOF(1) 'Выполняй, пока НЕ наступил КОНЕЦ ФАЙЛА 1
Input #1, Количество_попыток, A, Сообщение 'Чтение из файла данных очередной попытки
Print Количество_попыток, A, Сообщение 'Печать на форме истории угадываний
Loop
Close #1 'Закрыть файл №1
txtNumber.Text = A
txtMessage.Text = Сообщение
txtNumberTry.Text = Количество_попыток
Open App.Path & " \Данные.txt" For Append As #1 'Открыть для дозаписи под номером 1 файл Данные.txt из папки проекта
End Sub
Private Sub Form_Terminate()
Close #1 'Закрыть файл №1
End Sub
|
|