Binaryworld - Tunnel graphical effect ... [ VB -> Graphics ]

Usage

'Create a Form and place this code inside
'Sorry but the comments are in german :((
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