Решение заданий

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.

0

7.

Будет напечатано число 211.

8.

• 1001

• -100

• 15 -10

9.

82

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

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.

8

16.

29

17.

6

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 'Компьютер уменьшает вертикальную координату

37 В.

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? Причина в незначительных погрешностях, которые допускает компьютер при действиях с десятичными дробями (о чем я писал в 0.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 vbKeyR

Красная_лампа.FillColor = vbRed

Желтая_лампа.FillColor = vbBlack

Зеленая_лампа.FillColor = vbBlack

Case vbKeyY

Красная_лампа.FillColor = vbBlack

Желтая_лампа.FillColor = vbYellow

Зеленая_лампа.FillColor = vbBlack

Case vbKeyG

Красная_лампа.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

128.

'Вариант с использованием массива:

Private Function Fibonacci(Nomer As Integer) As Currency

Dim fib(1 To 70) As Currency

fib(1) = 1: fib(2) = 1

For i = 3 To Nomer: fib(i) = fib(i - 2) + fib(i - 1): Next

Fibonacci = fib(i - 1) 'Потому i - 1, что на выходе из цикла i равно Nomer + 1

End Function

'Вариант без использования массива:

Private Function Fibonacci1(Nomer As Integer) As Currency

fib1 = 1: fib2 = 1

For i = 3 To Nomer

fib3 = fib1 + fib2

fib1 = fib2

fib2 = fib3

Next

Fibonacci1 = fib3

End Function

Private Sub Command1_Click()

Debug.Print Fibonacci(68), Fibonacci1(68)

End Sub

129.

Dim a(1 To 5) As Integer 'Оценки одного класса

Dim b(1 To 5) As Integer 'Оценки другого класса

Private Function Минимум(c As Variant) As Integer

Минимум = c(1)

For i = 2 To 5

If c(i) < Минимум Then Минимум = c(i)

Next

End Function

Private Function Максимум(c As Variant) As Integer

Максимум = c(1)

For i = 2 To 5

If c(i) > Максимум Then Максимум = c(i)

Next

End Function

Private Function Разница(c As Variant) As Integer

Разница = Максимум(c) - Минимум(c)

End Function

Private Sub Command1_Click()

a(1) = 4: a(2) = 5: a(3) = 2: a(4) = 5: a(5) = 4

b(1) = 4: b(2) = 3: b(3) = 4: b(4) = 4: b(5) = 3

If Разница(a) < Разница(b) Then Debug.Print "Первый класс учится ровнее" _

Else Debug.Print "Второй класс учится ровнее"

End Sub

130.

Dim A(1 To 366) As Integer 'Показания термометра на станции A

Dim B(1 To 366) As Integer 'Показания термометра на станции B

Private Sub Исправление(ByVal Поправка As Integer, ByRef c)

For i = 1 To 4 'Для отладки приняли, что в году 4 дня.

c(i) = c(i) + Поправка

Next

End Sub

Private Sub Command1_Click()

A(1) = 24: A(2) = 25: A(3) = 28: A(4) = 25

B(1) = 14: B(2) = 16: B(3) = 14: B(4) = 17

Исправление -2, A

Исправление 3, B

For i = 1 To 4 'Распечатываем исправленные значения температур

Debug.Print A(i), B(i)

Next

End Sub

131.

Private Function fib(N As Integer) As Currency

If N = 1 Or N = 2 Then fib = 1 Else fib = fib(N - 2) + fib(N - 1) 'Изумительная лаконичность!

End Function

'За изумительную лаконичность расплачиваемся удручающе низким быстродействием.

'Когда N переваливает за пару десятков, результата приходится ждать.

'Ничего подобного не было при вычислении чисел Фибоначчи простым циклом.

'Почему так? А попробуйте подсчитать, сколько в памяти компьютера одновременно

'находится недовыполненных экземпляров подсчета функции fib.

Private Sub Command1_Click()

Debug.Print fib(20)

End Sub

132.

'Используем метод пузырька. У нас уже имеется соответствующая программа для одномерного массива.

'Однако, просто так, в лоб, переделать ее для двумерного массива затруднительно. Чтобы не ломать

'уже готовую структуру процедуры метода пузырька, вообразим, что мы работаем не с двумерным массивом,

'а с одномерным, получившимся считыванием двумерного строчка за строчкой. Далее. Все, что делает метод

'пузырька - это берет элемент одномерного массива с указанным номером и ставит его на новое место

'с указанным номером. Поэтому для правильной работы метода нам достаточно написать функцию "Возьми",

'которая по указанному номеру воображаемого одномерного массива вычисляет номер строки и столбца

'реального двумерного массива и берет оттуда элемент, а также процедуру "Положи", которая путем таких же

'вычислений кладет элемент не на воображаемое место, а на реальное.

Const M = 3 'M - число стpок в массиве

Const N = 4 'N - число столбцов

Dim a(1 To M, 1 To N) As Integer 'Исходный массив

Private Function Возьми(ByVal Номер As Integer) As Integer ' "Номер" - воображаемый номер элемента

i = (Номер + N - 1) \ N 'вычисляется номер строки

j = Номер Mod N 'вычисляется номер столбца

If j = 0 Then j = N

Возьми = a(i, j)

End Function

Private Sub Положи(ByVal Номер As Integer, ByVal Элемент As Integer)

' "Элемент" - это то, что мы кладем на место, указанное воображаемым номером "Номер"

i = (Номер + N - 1) \ N

j = Номер Mod N

If j = 0 Then j = N

a(i, j) = Элемент

End Sub

Private Sub Сортируем() 'Сортировка массива методом пузырька. Сравните с ранее написанной процедурой

For k = M * N To 2 Step -1

For i = 1 To k - 1

If Возьми(i) > Возьми(i + 1) Then

c = Возьми(i)

Положи i, Возьми(i + 1)

Положи i + 1, c

End If

Next i

Next k

End Sub

Private Sub Command1_Click()

a(1, 1) = 28: a(1, 2) = 14: a(1, 3) = 49: a(1, 4) = 18

a(2, 1) = 29: a(2, 2) = 28: a(2, 3) = 36: a(2, 4) = 20

a(3, 1) = 45: a(3, 2) = 15: a(3, 3) = 20: a(3, 4) = 25

Сортируем

For i = 1 To M 'Распечатываем массив после сортировки

Debug.Print

For j = 1 To N

Debug.Print a(i, j),

Next

Next

End Sub