Практическая часть. Пример №1. Нарисовать флаг Алжира

Пример №1. Нарисовать флаг Алжира.

Private Sub Form_Load()

Dim Z As New star 'Описываем новый объект на базу класса Star

Const pi = 3.1415926

AutoRedraw = True

Caption = "ФлагАлжира"

X1 = CurrentX + 100

Y1 = CurrentY + 100 'Размеры флага внутри окна формы

X2 = ScaleWidth - 100

Y2 = ScaleHeight - 100

ForeColor = RGB(255, 255, 255) 'Белый цвет

Line (X1, Y1)-(X2, Y2),, BF

ForeColor = RGB(0, 255, 0) 'Зеленый цвет

x3 = X2 / 2

y3 = Y2 / 2

Line (X1, Y1)-(x3, Y2),, BF

ForeColor = RGB(255, 0, 0) 'Красный цвет

For a! = 1 To 1.6 Step 0.01 'Рисуем полумесяц

Circle (x3 + 400, y3), 900,, pi / 2, 3 * pi / 2, a

Next

'Рисуем звезду из модуля Star1.dll

Call Z.Zvezda(x3 + 300, y3, 350, 150, 5, 0, ForeColor, Form1)

ForeColor = RGB(0, 0, 0) 'Black

DrawWidth = 3 'Ширина

FillStyle = 1 'прозрачный фон

Line (X1, Y1)-(X2, Y2),, B 'Обводим

End Sub

v Комментарии к программе.

Программа содержит ряд стандартный процедур и функций для рисования, но имеется и внешняя процедура Zvezda, которая описана в классе Star, находящемся в библиотеке Star1.dll. Для установления связи с библиотекой Star1.dll необходимо воспользоваться командой Project\References\кнопка Browse для поиска библиотеке на диске. Отыскав библиотеку на диске необходимо поставить в окне References около нее флажок. Формат процедуры сделующий.

Zvezda (<x>,<y>,<Rmax>,<Rmin>,<n>,<angle>,<Color>,<Object>) – рисует звезду в координатах x и y объекта Object, большим Rmax и малым Rmin радиусами, с количеством вершин n, имеющей угол базовой вершины angle относительно оси абцисс, цветом Color.

Пример №2. Отобразить в окне формы изменения двух графиков:

в диапазонах xÎ[-10…10], аÎ[0,1…1], bÎ[0…2], cÎ[0…2p].

Const pi = 3.1415926

Dim a As Single, b As Single, c As Single, x As Single

Private Sub Form_Load()

Picture1.Scale (-11, 1.1)-(11, -1.1)

MsgBox "Установите значения параметров и" _

& " щелкните в графическом окне", vbInformation, "Начало работы"

Text1.Text = Hs1.Value

Text2.Text = HS2.Value

Text3.Text = HS3.Value

End Sub

Private Sub Hs1_Change()

Text1.Text = Hs1.Value

End Sub

Private Sub HS2_Change()

Text2.Text = HS2.Value

End Sub

Private Sub HS3_Change()

Text3.Text = HS3.Value

End Sub

Private Sub Picture1_Click()

For x = -10 To 10 Step 0.01

Picture1.PSet (x, a * Sin(x) * Atn(x)), BackColor

Picture1.PSet (x, a * Sin(b * x - c)), BackColor

Next x

Picture1.DrawWidth = 2

Picture1.Line (-11, 0)-(11, 0)

Picture1.Line (0, 1.1)-(0, -1.1)

Picture1.DrawWidth = 1

Picture1.DrawStyle = 2 'Пунктир

For x = -10 To 10 Step 1 'Вертикальные оси

Picture1.Line (x, -1)-(x, 1)

Next x

For x = 1 To -1.1 Step -0.1 'Горизонтальные оси

Picture1.Line (-10, x)-(10, x)

Next x

a = 0.01 * Hs1.Value

b = 0.01 * HS2.Value

c = pi * HS3.Value / 180

Picture1.DrawWidth = 2

For x = -10 To 10 Step 0.01

Picture1.PSet (x, a * Sin(x) * Atn(x)), vbGreen

Picture1.PSet (x, a * Sin(b * x - c)), vbRed

Next x

End Sub

Пример №3. Анимация сообщения с использованием управляющего элемента Timer.

Dim s As String, x As Long, y As Long, w As Long

Private Sub Form_Load()

Timer1.Interval = 10

Timer1.Enabled = False

s = "Я хочу отдохнуть"

w = ScaleWidth - 100

x = 0

y = ScaleHeight / 2 - 200

Font.Bold = True

Font.Size = 14

Font.Name = "Arial"

End Sub

Private Sub Command1_Click()

CurrentX = x

CurrentY = y

ForeColor = QBColor(0)

Print s

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

CurrentX = x

CurrentY = y

ForeColor = BackColor

Print s

x = x + 30

If x < w Then

CurrentX = x

CurrentY = y

ForeColor = QBColor(0)

Print s

Else

x = 0

End If

End Sub

Пример №4. Анимация движения объекта (шарика) с использованием управляющего элемента Timer и метода MoveTo.

Dim h1 As Integer, h2 As Integer

Dim x As Integer, y As Integer

Private Sub Command1_Click()

x = Shape1.Left + h1

y = Shape1.Top + h2

Timer1.Enabled = True ‘ Запуск таймера

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Load()

Timer1.Interval = 10

Timer1.Enabled = False

Shape1.Shape = 3 'Circle - фигура

Shape1.FillStyle = 0 'Сплошная заливка

Shape1.FillColor = vbBlue 'Синий цвет заливки

Shape1.BorderColor = vbWhite 'Белый цвет контура

h1 = 50: h2 = 50 ‘ Шаг по х и у

End Sub

'Следующая процедура выполняется через равные промежутки времени:

Private Sub Timer1_Timer()

Shape1.Move x, y

'Определить следующую точку

x = x + h1

y = y + h2

If x > ScaleWidth - Shape1.Width Or x < 0 Then h1 = -h1

If y > ScaleHeight - Shape1.Height Or y < 0 Then h2 = -h2

End Sub

Пример №5. Построить спираль вокруг начала координат с размахом N и внешним радиусом R. Начальное направление спирали образует с осью X угол 0 градусов. Параметры А и N вводятся с клавиатуры. Параметрическое представление спирали: X=R*Cos(t); Y=R*Sin(t); R=t * A; 0<=t<=2Nπ.

Const pi = 3.1415926

Dim n As Integer, h As Integer

Private Sub Command1_Click()

Call Спираль

End Sub

Private Sub Form_Load()

Randomize

Caption = "Спираль"

AutoRedraw = True

WindowState = 0 '0->Normal screen, 2->Full screen

n = InputBox("Введите количество витков",, 10)

h = InputBox("Введите шаг спирали",, 25)

End Sub

Private Sub Спираль()

xr = ScaleWidth / 2

yr = ScaleHeight / 2

CurrentX = xr

CurrentY = yr

DrawWidth = 3

k! = pi / 100

For t = 0 To 2 * pi * n Step k

c& = QBColor(Rnd * 15)

r = t * h

x! = r * Cos(t)

y! = r * Sin(t)

Line -(x + xr, y + yr), c

Next

End Sub

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