Предметный указатель 2 страница

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

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

Программа отличается от той, что в разделе, одним числом:

x = x + 120

Программа отличается от предыдущей двумя числами:

x = 200

Do Until x > 8000

Вместо 100 пишем 200.

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

x = 4000: y = 3000: R = 100

Do Until R > 2500

Circle (x, y), R

R = R + 100

Loop

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

x = 4000: y = 500: R = 0

Do Until R > 2500

Circle (x, y), R,,,, 1 / 2

R = R + 50

y = y + 150

Loop

x = 400: y = 500: R = 0

Do Until R > 1500

Circle (x, y), R

R = R + 20

y = y + 60

x = x + 120

Loop

y = 0 'Разлиновывать начинаем с верхнего края формы

Do Until y > Height 'Разлиновываем до нижнего края формы

Line (0, y)-(Width, y) 'Линию проводим до правого края формы

y = y + 200 'Расстояние между линиями = 200

Loop

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

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

x = 100 'Квадраты начинаем рисовать от левого края формы

Do Until x > 8000 'Рисуем их до координаты 8000

Line (x, 3000)-(x + 1000, 4000),, B 'Ширина квадрата = 1000, высота = 4000-3000

x = x + 1500 'Шаг рисования квадратов = 1500

Loop

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

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

Вместо строки

Circle (x, y), 300

пишем строку

If x > 2000 Or y < 5000 Then Circle (x, y), 300

Вместо строки

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

которую можно вольно перевести так:

ЕСЛИ (это не левый нижний угол) И НЕПРАВДА, что (это квадрат в центре), ТО рисуй кружок

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

For i = 1 To 40

Circle (Width * Rnd, Height * Rnd), 200,,,, 1 / 2

Next

Private Sub Command4_Click()

For i = 1 To 150

Circle (Width * Rnd, Height * Rnd), 1000 * Rnd, 16777216 * Rnd

Next

End Sub

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

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

For i = 1 To 10000

Line (Width * Rnd, Height * Rnd)-(Width * Rnd, Height * Rnd), 16777216 * Rnd, BF

For j = 1 To 1000000: Next

Next

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

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

Я, король Франции, спрашиваю вас - кто вы такие? Вот ты - кто такой?

Я - Атос

А ты, толстяк, кто такой?

А я Портос! Я правильно говорю, Арамис?

Это так же верно, как то, что я -Арамис!

Он не врет, ваше величество! Я Портос, а он Арамис.

А ты что отмалчиваешься, усатый?

А я все думаю, ваше величество - куда девались подвески королевы?

Анна! Иди-ка сюда!!!

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

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

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

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

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

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 - неудачные имена, так как не говорят о смысле переменных. В будущем вы увидите, что можно было бы использовать уже применяющиеся имена - Выбор_цвета и Насыщенность.

Private Sub Command1_Click()

Debug.Print DateAdd("ww", 52, Date)

End Sub

Private Sub Command2_Click()

Дата_рождения = InputBox("Введите дату своего рождения")

Debug.Print DateDiff("s", Дата_рождения, Now)

End Sub

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

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 годами.

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

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

Private Sub Timer1_Timer()

Shape1.Top = Shape1.Top - 20

Shape2.Top = Shape2.Top - 20

End Sub

Private Sub Timer1_Timer()

Shape1.Top = Shape1.Top + 20

Shape2.Left = Shape2.Left + 20

End Sub

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

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

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

Private Sub Timer1_Timer()

Label1.FontSize = Label1.FontSize + 1

Label1.ForeColor = Label1.ForeColor + 10

End Sub

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

'В режиме проектирования поместим на форму прямоугольник и три круга.

'Назовем круги Красная_лампа, Желтая_лампа, Зеленая_лампа

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

'В режиме проектирования поместим на форму два 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

1) a(i) = a(i-1) + 4

2) a(i) = 2 * a(i-1)

3) a(i) = 2 * a(i-1) - 1

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

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

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

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

Private Sub Combo1_Click()

Combo2.Text = Combo2.List(Combo1.ListIndex)

End Sub

Я

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

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

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() 'Нажатие на кнопку попытки

Дата добавления: 2014-12-23