Keskustelu: Koodit: VB6: Starfield

Private Declare Function Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long) As Long
'KoTW tykkää, kun ei ryöstä niin paljoa prosessoria, pitää myös muis-
'taa DoEvents

Private Type Tähti                      'tähtityyppi
  X As Long                             'x-koordinaatti
  Y As Long                             'y-koordinaatti
  Suunta As Integer                     'mikähän...
  Vauhti As Single                      'voiskohan arvata
  Koko As Single                        'koko
End Type                                'pakollinen :D

Dim Tähti(1000) As Tähti, TähtiMäärä As Integer
'muuttujamäärittelyt

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  End                                   'näppäimen painalluksesta
End Sub                                 'pois

Private Sub Form_Load()
  Randomize Timer                       'alustetaan satunnaislukugeneraattori
  Me.AutoRedraw = True                  'ei välkkyisi
  Me.Caption = "Star Field made by KoTW" 'otsikko ja oma nimi mukaan
  Me.Show                               'olisi kiva jos ikkuna näkyisi
  Me.BackColor = 0                      'musta tausta
  Me.ForeColor = 16777215               'ja valkoinen väri piirtoon
  TähtiMäärä = 10                       'alustetaan tähtien määrä
  For i = 0 To 10                       'ja alustetaan niiden sijainti ym.
    Tähti(i).X = Me.Width / 2           'keskelle ruutua
    Tähti(i).Y = Me.Height / 2          'tämäkin keskelle
    Tähti(i).Suunta = Int(360 * Rnd)    'suunta satunnaiseksi
    Tähti(i).Vauhti = 5 + 2 * Rnd       'samat vauhdille
    Tähti(i).Koko = 1                   'ja koko pieneksi
  Next i                                'silmukan loppu
  Looppaa                               'kutsutaan looppaa-aliohjel-
End Sub                                 'maa, joka huolehtii tästä

Private Sub Looppaa()                   'looppaa-aliohjelma
  Dim a As Single                       'hidastetta varten
  Do                                    'aloittakaamme silmukka
    Liikuta                             'pitääkö muka liikuttaa
    Piirrä                              'miksi piirtäisin
    a = Timer + 0.01                    'muuta tätä niin hidastat/nopeutat
    Do                                  'hidaste alkaa
      Sleep 10                          'ite odotus
      DoEvents                          'winkkari tarvitsee aikaa omiin hommiinsa o_O
    Loop Until Timer > a                'hidasteen loppu
  Loop                                  'ja silmukan loppu
End Sub

Private Sub Form_Unload(Cancel As Integer)
  End                                   'ilman tätä lopetus lagaa
End Sub

Private Sub Liikuta()
  Randomize Timer                       'alustetaan satunnaislukugeneraattori
  For i = 0 To TähtiMäärä               'elikkä joka tähdelle käy näin huonosti
    If YliRuudun(Tähti(i)) Then         'jos yli ruudun niin...
      Tähti(i).X = Me.Width / 2         'keskelle
      Tähti(i).Y = Me.Height / 2        'keskelle tääkin
      Tähti(i).Suunta = Int(360 * Rnd)  'ja suunta satunnaiseksi
      Tähti(i).Vauhti = 2 + 5 * Rnd     'samat vauhdille
      Tähti(i).Koko = 1                 'ja koko pieneksi
    End If                              'If-hässäkän loppu
  Tähti(i).X = Tähti(i).X + (Cos(Tähti(i).Suunta) * Tähti(i).Vauhti)
  'uusi x-positio
  Tähti(i).Y = Tähti(i).Y + (Sin(Tähti(i).Suunta) * Tähti(i).Vauhti)
  'uusi y-positio
  Tähti(i).Koko = Tähti(i).Koko + 0.01  'ja lisää kokoa
  Next i                                'silmukan loppu
  If TähtiMäärä < 1000 Then             'ettei tulisi virhettä
  TähtiMäärä = TähtiMäärä + 1
  Tähti(TähtiMäärä).X = Me.Width / 2  'keskelle
  Tähti(TähtiMäärä).Y = Me.Height / 2 'keskelle tääkin
  Tähti(TähtiMäärä).Suunta = Int(360 * Rnd)
  'ja suunta satunnaiseksi
  Tähti(TähtiMäärä).Vauhti = 2 + 5 * Rnd
  'samat vauhdille
  Tähti(TähtiMäärä).Koko = 1          'ja koko alustetaan
  End If
End Sub

Private Sub Piirrä()
  Cls                                   'hienompi ilman edellisiä roskia
  For i = 0 To TähtiMäärä               'ja joka tähti läpi
    DrawWidth = Tähti(i).Koko           'tietyn paksuinen pitää olla
    PSet (Tähti(i).X, Tähti(i).Y), 16777215
    'piirretään
  Next i                                'ja seuraava rassukka käsittelyyn
End Sub

Private Function YliRuudun(stara As Tähti) As Boolean
If stara.X < 0 Or stara.Y < 0 Or stara.X > Me.Width Or stara.Y > Me.Height Then YliRuudun = True: Else: YliRuudun = False
'tarkistaa onko yli ruudun
End Function