Tools Links Login

Tunnel graphical effect

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

About this post

Posted: 2019-10-02
By: KlausPeterk
Viewed: 202 times

Categories

Visual Basic 6

Attachments

No attachments for this post

Special Instructions

This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.