Салют

Работа с 2D и 3D графикой, видео, звуком.

Модератор: Mikle

The trick
Постоялец
Постоялец
 
Сообщения: 512
Зарегистрирован: 26.06.2010 (Сб) 23:08

Салют

Сообщение The trick » 30.07.2014 (Ср) 21:48

Простой код салюта на VB6, используя только встроенные графические возможности.
Код: Выделить всё
Option Explicit

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundW" (ByVal lpszName As Long, ByVal hModule As Long, ByVal dwFlags As Long) As Long

Private Const SND_ASYNC = &H1
Private Const pi = 3.14

Private Function Draw(v As Long, cc As Long) As Boolean
    Dim dh As Single, c As Single, d As Single, x As Single, y As Single, w As Long, i As Long, dx As Single, dy As Single, _
        gr As Single, r As Single, g As Single, b As Single, n As String
    Rnd v: cc = cc + 2
    If cc <= 0 Then
        Exit Function
    ElseIf cc <= 100 Then
        If cc = 2 Then n = App.Path & "\1.wav": PlaySound StrPtr(n), 0, SND_ASYNC
        dh = 100 / cc: x = Rnd * 0.75 + 0.125 + (cc * ((v And 2) - 1)) / 1000: y = Sin((cc - 2) / 200 * pi) * 0.75
        w = 21 - cc * 0.2: d = 255 / w: c = 0
        Do: c = 255 / w: DrawWidth = w: PSet (x, y), RGB(c, c, 0): w = w - 1: Loop While w
    ElseIf cc < 300 Then
        If cc = 102 Then n = App.Path & "\0.wav": PlaySound StrPtr(n), 0, SND_ASYNC
        dh = (cc - 100) / 200: gr = (1 - Cos(dh * pi * 0.25)) * dh: dx = Rnd * 0.75 + 0.125 + ((v And 2) - 1) / 10
        dy = 0.75 - gr: i = Rnd * 100 + 200: gr = 1 - 0.2 ^ (dh * 5): dh = 1 - dh
        r = Rnd * 0.8 + 0.2: g = Rnd * 0.8 + 0.2: b = Rnd * 0.8 + 0.2
        If cc < 150 Then
            b = (1 - (cc - 100) / 50) * 3
            For w = (cc - 100) * 2 To 1 Step -1
                DrawWidth = w * 5: c = cc / w * b: PSet (dx, dy), RGB(c * r, c * g, c * b)
            Next
        End If
        Do While i
            c = Rnd * pi * 2: d = gr * (Rnd * 0.8 + 0.2) * 0.5: x = Cos(c) * d + dx: y = Sin(c) * d + dy
            w = (dh * 6) * Abs(Sin((cc + i) / 10 * pi)) + 1: c = 0
            Do: c = 512 / w * dh: DrawWidth = w: PSet (x, y), RGB(c * r, c * g, c * b): w = w - 1: Loop While w
            i = i - 1
        Loop
    Else: Draw = True: cc = 0: v = v - Rnd * 100
    End If
End Function
Private Sub Form_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    Randomize
End Sub
Private Sub Form_Resize()
    Scale (0, 1)-(1, 0)
End Sub
Private Sub tmrTimer_Timer()
    Static a1 As Long, a2 As Long, c1 As Long, c2 As Long
    If a1 = 0 Then a1 = -(Rnd * 100) - 1: a2 = a1 - 2: c2 = -150
    Call Cls: Draw a1, c1: Draw a2, c2
End Sub


Изображение

Выход - щелчок.
У вас нет доступа для просмотра вложений в этом сообщении.
UA6527P

Mikle
Изобретатель велосипедов
Изобретатель велосипедов
Аватара пользователя
 
Сообщения: 3819
Зарегистрирован: 25.03.2003 (Вт) 14:02
Откуда: Туапсе

Re: Салют

Сообщение Mikle » 01.08.2014 (Пт) 16:02

Где-то я это уже комментировал, повторюсь.
В целом эффектно, нравится.
Можно сделать для пущей реалистичности задержку на воспроизведение звука.
После взрыва в центре на некотором радиусе не остаётся ракет, это неправильно.

tych
Начинающий
Начинающий
 
Сообщения: 11
Зарегистрирован: 03.12.2013 (Вт) 0:16
Откуда: Russia, Kaliningrad

Re: Салют

Сообщение tych » 04.12.2014 (Чт) 23:02

Здорово! Глядя на это точно не скажешь, что код такой короткий. Если бывают CrackMe, то это скорей UnderstandMe =)
А после возникает филосовский вопрос - неужели к такому алгоритму люди приходят математически? То есть есть задача - описать что-то функциями - и вперед?
Стыдно сказать - у меня навскидку такая задача заняла бы не одну сотню строк -) Там и массив частиц был бы на каждый взрыв, и векторы скорости -))) Ну и про DrawWidth совсем не знал... чУдно!

The trick
Постоялец
Постоялец
 
Сообщения: 512
Зарегистрирован: 26.06.2010 (Сб) 23:08

Re: Салют

Сообщение The trick » 04.12.2014 (Чт) 23:12

tych писал(а):А после возникает филосовский вопрос - неужели к такому алгоритму люди приходят математически? То есть есть задача - описать что-то функциями - и вперед?

Да.
UA6527P


Вернуться в Мультимедиа

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3

    TopList