'Декларация на анимиращата функция StretchBlt

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Dim X1a, X2a, X1b, X2b, dXa, dXb, dYa, dYb 'Декларация на границите и отклоненията по X и по Y

Dim X1, X2, X3, X4, X5, X6, X7, X8 ' Декларация на моментната кордината по X на топчетата

Dim Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8 ' Декларация на кординатите по Y на топчетата

Dim Flag1, Flag2, Flag3, Flag4, Flag5, Flag6, Flag7, Flag8 ' Декларация на флаговете за посока на топчетата

 

Private Sub Command1_Click()

On Error Resume Next ' манипулатор на грешка

 If Command1.Caption = "СТАРТ" Then ' Стартиране на анимацията

    Command1.Caption = "СТОП" ' Сменяме надписа на бутона

    Flag1 = 1: Flag2 = 1: Flag3 = 1: Flag4 = 1: Flag5 = 1: Flag6 = 1: Flag7 = 1: Flag8 = 1 ' Задаваме начална посока

    ' Въвеждаме от текстовите полета на формата границите и отклоненията в променливите

    X1a = Val(X1aText.Text): X2a = Val(X2aText.Text): dXa = Val(dXaText.Text): dYa = Val(dYaText.Text): dXXa = Val(dXXaText.Text)

    X1b = Val(X1bText.Text): X2b = Val(X2bText.Text): dXb = Val(dXbText.Text): dYb = Val(dYbText.Text): dXXb = Val(dXXbText.Text)

    ' Задаваме началното разположение по X и по Y на топчетата

    X1 = X1a: X2 = X1 + dXXa: X3 = X2 + dXXa: X4 = X1a: X5 = X1b: X6 = X5 + dXXb: X7 = X5: X8 = X6

    Y1 = Y1aText.Text: Y2 = Y1 + dYa: Y3 = Y2 + dYa: Y4 = Y3 + dYa: Y5 = Y1bText.Text: Y6 = Y5 + dYb: Y7 = Y6 + dYb: Y8 = Y7 + dYb

    TimerAnimacia.Enabled = True 'Пускаме таймера за анимация

 Else ' Спиране на анимацията

    Command1.Caption = "СТАРТ" ' Сменяме надписа на бутона

    TimerAnimacia.Enabled = False 'Спираме таймера за анимация

End If

End Sub

 

Private Sub TimerAnimacia_Timer()

    'Задаваме на анимиращата функция истинския размер на малката картинка

    Hirina = Malka.ScaleWidth

    Visochina = Malka.ScaleHeight

    'Изчиства голямата картинка

    Goliama.Cls

For j = 1 To 8 ' Цикъл за последователно изрисуване на 8-те малки картинки на съответните различни кординати

    'Задаване на конкретната кордината X за изрисуване в зависимост от това коя е по ред картинката

    If j = 1 Then X = X1: Y = Y1: Stretch = 80 ' Намаляване на 80%(zoom)

    If j = 2 Then X = X2: Y = Y2

    If j = 3 Then X = X3: Y = Y3

    If j = 4 Then X = X4: Y = Y4

    If j = 5 Then X = X5: Y = Y5: Stretch = 100 ' Увеличава на 100%(zoom)

    If j = 6 Then X = X6: Y = Y6

    If j = 7 Then X = X7: Y = Y7

    If j = 8 Then X = X8: Y = Y8

    'Прерисуващи функции с кординати X и Y

    StretchBlt Goliama.hdc, X, Y, Stretch, Stretch, Maska.hdc, 0, 0, Hirina, Visochina, vbSrcAnd

    StretchBlt Goliama.hdc, X, Y, Stretch, Stretch, Malka.hdc, 0, 0, Hirina, Visochina, vbSrcPaint

Next j

 

    Goliama.Refresh 'Обновява Голямата картина с нарисуваните върху нея с нови картинки

    'Изпълнение на процедура за промяна на настоящата кордина X и посоката при достигане на граници

    ProverkaZaPosoka X1, dXa, X1a, X2a, Flag1

    ProverkaZaPosoka X2, dXa, X1a, X2a, Flag2

    ProverkaZaPosoka X3, dXa, X1a, X2a, Flag3

    ProverkaZaPosoka X4, dXa, X1a, X2a, Flag4

    ProverkaZaPosoka X5, dXb, X1b, X2b, Flag5

    ProverkaZaPosoka X6, dXb, X1b, X2b, Flag6

    ProverkaZaPosoka X7, dXb, X1b, X2b, Flag7

    ProverkaZaPosoka X8, dXb, X1b, X2b, Flag8

dole:

End Sub

 

'Самата процедура за промяна на кординатата X и посоката

Private Sub ProverkaZaPosoka(Kordinata, Otklonenie, LevaFranica, DesnaGranica, Posoka)

    Kordinata = Kordinata + Otklonenie * Posoka

    If Kordinata >= DesnaGranica Then Posoka = -1

    If Kordinata <= LevaFranica Then Posoka = 1

End Sub

 

' Показване на Frame1 с настройките

    Private Sub Command2_Click()

    Frame1.Visible = True

End Sub

 

' Спиране и пускане на анимацията при промяна на текстовото поле задаващо скорост, чрез двойно натискане на бутона СТАРТ

Private Sub dXaText_Change()

    Command1_Click

    Command1_Click

End Sub

 

' Спиране и пускане на анимацията при промяна на текстовото поле задаващо скорост, чрез двойно натискане на бутона СТАРТ

Private Sub dXbText_Change()

    Command1_Click

    Command1_Click

End Sub

 

Private Sub Form_Load()

    ' Разрешава прерисуване по картинката

    Goliama.AutoRedraw = True

    ' Оразмерява картинката в пиксели

    Goliama.ScaleMode = vbPixels

End Sub