Koodit: VB6: Lävistäjäleikki

'Const EiVärejä = 1 'selkeämpää muttei hieanoja värejä, koklaa epäkommentoida
Private kulmat 'kulmat näkyy joka subissa ettei häviä välillä.
Const pi = 3.14159265358979
Private Sub Form_Load()

    AutoRedraw = True 'aina päälle tämä!
    ScaleMode = 3 'pixelit
    kulmat = 5 'aluksi kulmia on 5kpl oletuksena
    piirrä 'piirretään

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = 1 Then kulmat = kulmat + 1 'vasemmalla napilla lisätään kulmia
    If Button = 2 Then kulmat = kulmat - 1 'oikeella napilla vähennetään kulmia
    If kulmat = 2 Then kulmat = 3 'minimimäärä kulmille on 3
    piirrä 'piirrä uusi lelu

End Sub


Sub piirrä() 'ite piirtojutsku

    Cls 'vanha kuva pois
    Caption = kulmat 'kerrotaan montako kulmaa on
    ReDim kx(kulmat), ky(kulmat) 'kulmakoordinaatit
    koko = ScaleWidth 'halkaisija
    If ScaleHeight < koko Then koko = ScaleHeight 'halkaisijatarkistus ettei kuva ylity reunojen
    koko = koko / 2 'halkaisija säteeksi
    For i = 0 To kulmat - 1 'lasketaan kulmien koordinaatit jotta saataisiin säännöllinen monikulmio
        kx(i) = koko * Cos(k * pi / 180)
        ky(i) = koko * Sin(k * pi / 180)
        k = k + 360 / kulmat 'lisätään tietyn verran että pisteiden välit olisi yhtä pitkiä
    Next
    koko = 255 * 8 / kulmat 'väritysjutsku
    For i = 0 To kulmat - 1 'piiretään joka kulmasta viiva
        If EiVärejä Then r = 0: g = 0: b = 0 'jos ei värejä niin väri on musta joka viivalla
        For j = i + 1 To kulmat - 1  'piirretään viiva joka kulmaan johon ei olla vielä piirretty
            Line (ScaleWidth / 2 + kx(i), ScaleHeight / 2 + ky(i))-(ScaleWidth / 2 + kx(j), ScaleHeight / 2 + ky(j)), RGB(r, g, b)
        Next
        If i + 1 > kulmat - 1 Then 'vika viiva on myös tietyn värinen
                                   'vaikee selittää, kommentoi toi line niin tajuat
            Line (ScaleWidth / 2 + kx(0), ScaleHeight / 2 + ky(0))-(ScaleWidth / 2 + kx(kulmat - 1), ScaleHeight / 2 + ky(kulmat - 1)), RGB(r, g, b)
        End If
        Select Case v \ 255 'mikä värijutsku menossa
            Case 0 'siirretään r päin
                r = tark(r + koko)
            Case 1 'siirretään g päin
                r = tark(r - koko)
                g = tark(g + koko)
            Case 2 'siirretään b päin
                g = tark(g - koko)
                b = tark(b + koko)
            Case 3 'siirretään rg päin
                b = tark(b - koko)
                r = tark(r + koko)
                g = tark(g + koko)
            Case 4 'siirretään gb päin
                r = tark(r - koko)
                b = tark(b + koko)
            Case 5 'siirretään rb päin
                r = tark(r + koko)
                g = tark(g - koko)
            Case 6 'siirretään rgb päin
                g = tark(g + koko)
            Case 7 'siirretään tyhjyyttä päin
                r = tark(r - koko)
                g = tark(g - koko)
                b = tark(b - koko)
        End Select
        v = v + koko 'lisätään värilaskuria
    Next

End Sub

Function tark(mikä) 'värin tarkistus ettei mene yli reunojen

    If mikä < 0 Then
        tark = 0
    ElseIf mikä > 255 Then
        tark = 255
    Else
        tark = mikä
    End If

End Function