Keskustelu: Koodit: VB6: Meitriks

Const ne = 30 'tippuvia rivejä yhteensä
Const Min_Pituus = 4, Max_Pituus = 15 'rivin kokorajat
Private x(ne), y(ne), p(ne), m(ne), n(ne) 'rivin aloitusx ja y ja pituus, merkit ja nopeus.
Private Sub Form_Load()

    Show 'näkyviin :P
    Move Left, Top, 640 * 15, 480 * 15 'kivan kokoiseksi
    Caption = "Initoidaan Meitriks..." 'kerrotaan mitä tehdään jos o hidas kone
    Randomize Timer 'alustetaan visual basicin sisäänrakennettu lineaarinen satunnaislukugeneraattori (:D)
    AutoRedraw = True 'mukava ominaisuus piirtäessä
    picture1.BackColor = 0 'taustavärit nätin mustaksi
    BackColor = 0 '...
    picture1.ScaleMode = 3 'picture1pipiktuurilaatikko pikselimoodiseksi, twipit haisee
    ScaleMode = 3 'haisee edelleen, hyh
    picture1.AutoRedraw = True 'supah ominaisuus piirtäessä
    picture1.Font = "Courier New" 'kaunis fontti, tasavälinen=kiva
    picture1.FontSize = 12 'mukava koko
    picture1.Visible = False 'picture1pipuskuripiirtoloota piiloon
    For i = 1 To ne 'alustetaan rivit
        arvo i
    Next
    Timer1.Interval = 50 'ja ajastin päälle
    Caption = "Meitriks" 'ja otsikko kuntoon

End Sub 'ja menoks :P

Private Sub Form_Resize()

    picture1.Move 0, 0, ScaleWidth, ScaleHeight 'kuvapuskuri oikean kokoiseksi

End Sub

Private Sub Form_Unload(Cancel As Integer)

    End 'joskus jää piiloon luuppaamaan johonki do...looppiin

End Sub

Private Sub Timer1_Timer()

    picture1.Cls 'vanhat roskat veks
    For i = 1 To ne 'siirretään joka riviä
        juttu = y(i) - p(i) 'mihin asti piirretään
        If juttu < 0 Then juttu = 0 'ei piirretä formin ulkopuolelle
        For t = y(i) To juttu Step -1 'piirretään rivi päästä häntään
            DoEvents 'ettei ohjelma tilttaa, nimim. kokemusta on
            picture1.CurrentX = picture1.FontSize * x(i) 'siirretään piirtokohta oikeaan kohtaan
            picture1.CurrentY = picture1.FontSize * t '...
            picture1.ForeColor = RGB(0, picture1.CurrentY / picture1.ScaleHeight * 200 + 55, 0) 'väri kivaksi
            picture1.Print Mid(m(i), y(i) - t + 1, 1) 'ja ulostetaan merkki
        Next 'seuraava rivi
        y(i) = y(i) + n(i) 'tiputetaan merkkiä alas
        If juttu >= ScaleHeight \ picture1.FontSize Then arvo i 'jos rivi menee alas niin tehdään uus rivi
        skroll i 'skrollataan rivin merkit taaksepäin niin että merkit pysyy hieanosti samassa kohdassa näytöllä
    Next
    Picture = picture1.Image 'näytetään kuva

End Sub

Sub arvo(i) 'alustaa rivin i

    x(i) = ran(2, ScaleWidth \ picture1.FontSize) 'vasemmalta koordinaatti
    y(i) = 1 'ylhäälle
    p(i) = ran(Min_Pituus, Max_Pituus) 'pituus
    m(i) = ""
    For t = 1 To p(i) 'ja merkit
        m(i) = m(i) + Chr(ran(33, 255))
    Next
    n(i) = ran(1, 5) 'nopeus

End Sub

Sub skroll(i) 'skrollaa rivin merkkejä yhden askeleen taaksepäin ja arpoo uuden merkin päähän
              'niin että tulee hieano ehvekti, merkit jää siihen ruudulle silleen jännästi(:P)
    For t = p(i) To 1 + n(i) Step -1 'skrollataan
        DoEvents
        Mid(m(i), t, 1) = Mid(m(i), t - n(i), 1)
    Next
    For t = 1 To n(i) 'arvotaan uudet merkit
        Mid(m(i), t, 1) = Chr(ran(33, 255))
    Next

End Sub

Function ran(a, b) 'arpoo randomuusisti a ja b väliltä

    ran = Int((a - b + 1) * Rnd + b)

End Function