Koodit: VB6: Värien häivytystä

Private mikämenossa 'mikä hieano menossa

Private Sub Form_click()

    'hiiren klikkauksesta vaihtuu kuva
    mikämenossa = (mikämenossa + 1) Mod 4
    hieano mikämenossa

End Sub

Private Sub Form_Load()

    ScaleMode = 3 'pixelit käyttöön
    AutoRedraw = True 'automaattinen uudelleenpiirto(?) päälle
    Caption = "Hieano VäriSysteemi, Eikös Olekin?" 'otsikko oikein :)
    BackColor = 0 'kaunis väri
    hieano 0 'piirretään eka hieano

End Sub

Sub hieano(mikä)

    pi = 4 * Atn(1)
    Cls 'edellinen vek
    If mikä = 0 Then 'katsotaan mikä hieano tehdään
        'tämä fadettaa r:n, g:n ja b:n ja niiden sekoitukset palkeittain
        Dim c(2) 'värit: c(0)=r, c(1)=g, c(2)=b
        v = 1 'v niinkuin värijuttu :P
        koko = (7 * 255) / ScaleWidth 'paljonko siirretään väriä kerralla
        For moov = 0 To ScaleWidth 'piirretään vasemmalta oikeelle formi täyteen
            For i = 0 To 2 'r,g ja b läpi
                If v And 2 ^ i Then 'jos v ja värin bitti on päällä niin...
                    c(i) = c(i) + koko '...muutetaan väriä
                    If c(i) > 255 Then 'jos väripalkki on lopussa niin...
                        c(0) = 0 '...alustetaan arvot...
                        c(1) = 0
                        c(2) = 0
                        v = v + 1 '...ja mennään seuraavaan
                    End If
                End If
            Next
            Line (moov, 0)-(moov, ScaleHeight), RGB(c(0), c(1), c(2)) 'piirretään väriviiva formin ylälaidasta alas
        Next
    ElseIf mikä = 1 Then
        'sama kuin edellinen mutta ympyränä
        Dim k(2) 'värit: k(0)=r, k(1)=g, k(2)=b
        säde = ScaleWidth 'katsotaan halkaisija
        If ScaleHeight < säde Then säde = ScaleHeight 'pallo ei saa mennä yli reunojen
        säde = säde / 2 'säde on puolet halkaisijasta
        koko = (7 * 255) / 360  'paljonko siirrytään kerralla jotta koko pallo täyttyisi
        FillStyle = vbSolid 'jotta piirakan osat täyttyisi, pelkillä viivoilla...
                            '...ei tulisi pallon muotoa.
        v = 1 'v niinkuin värijuttu :P
        For moov = 0 To 360  'piirretään ymbyrä
            For i = 0 To 2 'r,g ja b läpi
                If v And 2 ^ i Then 'jos v ja värin bitti on päällä niin...
                    k(i) = k(i) + koko '...muutetaan väriä
                    If k(i) > 255 Then 'jos väripalkki on lopussa niin...
                        k(0) = 0 '...alustetaan arvot...
                        k(1) = 0
                        k(2) = 0
                        v = v + 1 '...ja mennään seuraavaan
                    End If
                End If
            Next
            FillColor = RGB(k(0), k(1), k(2)) 'täyttöväri
            'piirretään piirakkapala, moov*pi/180 tarkoittaa asteet radiaaneiksi
            Circle (ScaleWidth / 2, ScaleHeight / 2), säde, FillColor, -viime_moov * pi / 180, -moov * pi / 180
            viime_moov = moov 'viime x kohta jotta piirakkapala toimisi
        Next
        'joskus tehdään jännän näköinen kuvio jossa on vain reunat eli piirretään musta ymbura keskelle
        If Int(Rnd + 0.5) Then Circle (ScaleWidth / 2, ScaleHeight / 2), säde - 70 * Rnd, 0
    ElseIf mikä = 2 Then
        'fadettaa niin että eri värit fadeaa toisiinsa...
        koko = (8 * 255) / ScaleWidth 'paljonko siirretään väriä kerralla
        v = 1: r = 0: g = 0: b = 0 'alustetaan muuttujat
        For moov = 0 To ScaleWidth 'piirretään vasemmalta oikealle
            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ärivariaapelia
            Line (moov, 0)-(moov, ScaleHeight), RGB(r, g, b) 'piirretään
        Next
    ElseIf mikä = 3 Then
        'edellinen ympyränä...
        säde = ScaleWidth 'katsotaan halkaisija
        If ScaleHeight < säde Then säde = ScaleHeight 'pallo ei saa mennä yli reunojen
        säde = säde / 2 'säde on puolet halkaisijasta
        koko = (8 * 255) / 360
        v = 1: r = 0: g = 0: b = 0
        FillStyle = vbSolid
        For moov = 0 To 360 'piirretään vasemmalta oikealle
            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
            FillColor = RGB(r, g, b)
            Circle (ScaleWidth / 2, ScaleHeight / 2), säde, FillColor, -viime_moov * pi / 180, -moov * pi / 180
            viime_moov = moov
        Next
        If Int(Rnd + 0.5) Then Circle (ScaleWidth / 2, ScaleHeight / 2), säde - 70 * Rnd, 0
    End If

End Sub

Function tark(arvo) 'tarkistetaan jos joku arvo menee yli rajojen niin ei anneta sen
    'värit rgb:ssä ei saa mennä alle 0 tai yli 255.
    If arvo > 255 Then
        tark = 255
    ElseIf arvo < 0 Then
        tark = 0
    Else
        tark = arvo
    End If

End Function

Private Sub Form_Resize()

    hieano mikämenossa 'kun formin koko vaihtuu niin kuva piirretään uusiksi

End Sub