Tunnel graphical effect

By | 2019-10-02

Create a Form and place this code inside. Sorry but the comments are in german.

Code

Option Explicit

Dim offx%                 ' x-offset zur mitte
Dim offy%                 ' y-offset zur mitte
Dim anz%                 ' anzahl sterne
Dim bahnx%(100, 180)     ' x-tab
Dim bahny%(100, 180)     ' y-tab
Dim starwi%(500)            ' anz%
Dim starba%(500)            ' anz%
Dim cosi(360)             ' cos-tab
Dim sini(360)             ' sin-tab
Dim st%
Dim wert                 ' rad in deg
Dim x%                     ' x-start
Dim y%                     ' y-start
Dim gr%                    ' groesse (radius)
Dim i%                     ' I
Dim ba%                    ' bahnenindex
Dim wi%                    ' winkelindex
Dim starbaz%             ' bahnenzaehler
Dim starwiz%             ' winkelzaehler
Dim by2%                 ' für mal 2
Dim a%

Private Sub Form_Activate()
    main
End Sub

Private Sub Form_Click()
    End
End Sub

Private Sub main()
    Dim xoff%
    Dim yoff%

    xoff% = ScaleWidth / 2 - 160
    yoff% = ScaleHeight / 2 - 100
    anz% = 400
    st% = 10
    wert = 3.1415 / 180
    x% = -25
    y% = 30
    gr% = 30
    
    For i% = 0 To 360
        sini(i%) = Sin(i% * wert)
        cosi(i%) = Cos(i% * wert)
    Next i%
    
    For ba% = 0 To 100
        gr% = gr% + (ba% / 20)
        x% = x% + 4 - (ba% / 40)
        y% = y% + 1
        For wi% = 0 To 180
            by2% = wi% + wi%
            bahnx%(ba%, wi%) = sini(by2%) * gr% + x% + xoff%
            bahny%(ba%, wi%) = cosi(by2%) * gr% + y% + yoff%
        Next wi%
    Next ba%
    
    For i% = 0 To anz%
        starwi%(i%) = Rnd(Timer) * 45
        starba%(i%) = Rnd(Timer) * 100
    Next i%
    
    a% = 0
    ForeColor = QBColor(15)
    Do
        For i% = 0 To anz%
            starbaz% = starba%(i%)
            starwiz% = starwi%(i%)
            PSet (bahnx%(starbaz%, starwiz%), bahny%(starbaz%, starwiz%)), 0
            starwiz% = starwiz% + 1
            starbaz% = starbaz% + 1
            If starbaz% > 100 Then
                starbaz% = 0
            End If
            If starwiz% > 180 Then
                starwiz% = 0
            End If
            PSet (bahnx%(starbaz%, starwiz%), bahny%(starbaz%, starwiz%))
            starwi%(i%) = starwiz%
            starba%(i%) = starbaz%
        Next i%
        a% = a% + 1
        If a% > 10 Then
            a% = 0
            DoEvents
        End If
    Loop
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    End
End Sub

Private Sub Form_Load()
    Me.WindowState = vbMaximized
    Me.BorderStyle = 0
    Me.Appearance = 0
    Me.Caption = ""
    Me.BackColor = vbBlack
    Me.ScaleMode = 3
End Sub

Author: dwirch

Derek Wirch is a seasoned IT professional with an impressive career dating back to 1986. He brings a wealth of knowledge and hands-on experience that is invaluable to those embarking on their journey in the tech industry.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.