Koodit: VB6: Metapalloja monivärisinä

Kirjoitettu: 21.05.2004 – 21.05.2004

Tagit: grafiikka, koodi näytille, vinkki

Kun nämä metapallot nyt tuntuvat olevan jälleen muodissa, niin lukaisinpa minäkin pekin oppaan ja tekaisin oman versioni metapalloista. Ajattelin aluksi pistää QB-version, mutta väriskaala oli ikävän karkea.
Tässä koodissa käyttäjä pääsee itse käsittelemään metapalloja, eli vaihtamaan niiden paikkaa, kokoa sekä myös väriä. Metapalloista voi tehdä joko punaisia, vihreitä tai sinisiä. Kun erivärisiä metapalloja vie toistensa lähelle, värit sekoittuvat. Esimerkiksi punaisen ja sinisen metapallon päällekkäin osuvat kohdat ovat väriltään violetteja. Kun jokaista kolmea väriä osuu samaan kohtaan, väri on loogisesti valkoinen.
Koodi sijoittaa kaikki oliot automaattisesti oikeille paikoilelen. Käyttäjän tarvitsee vain luoda kolme CommandButtonia, kaksi TextBoxia ja kaksi HScrollBaria. Formin kokoa koodi ei muuta, mutta kannattaa vetää vähän yli 400x300 pikselin kokoon.
Ohjelmaa voi olla vähän vaikea käyttää, mutta muokattava metapallo valitaan ensimmäisellä ScrollBarilla, ja tuo metapallo näkyy silloin mustana. Paikkaa vaihdetaan klikkaamalla hiiren vasemmalla napilla. Väriä vaihdetaan oikealla. Kokoa vaihdetaan toisesta ScrollBarista. CLEAR tyhjää formin, RANDOM arpoo pallot satunnaisesti, ja RENDER näyttää kuvan, jonka metapallot muodostavat.
Kuten peki minulle huomautti, värien sekoittuminen pilaa varsinaisen yhdistymisefektin, joten sitä on paras kokeilla käyttämällä vain yksivärisiä metapalloja.
Huom! Formin ScaleModeksi on syytä asettaa Pixel Twipin sijaan. AutoRedraw kannattaa myös olla True.

Dim M(1 To 8, 1 To 4) As Integer
Dim ch As Integer
Dim QB(1 To 3) As Integer

Private Sub Command1_Click()

Dim G(1 To 3) As Long

Max = 8

'metapallojen renderöinti

For b = 1 To 300  'Y-akseli
    DoEvents
For a = 1 To 400  'X-akseli
G(1) = 0: G(2) = 0: G(3) = 0

    For c = 1 To Max    'Metapallot

    'metapallojen laskukaava 1/x^2  (jokainen metapallo voimistaa oman värinsä "sähkökenttää")
        G(M(c, 4)) = G(M(c, 4)) + M(c, 3) / Sqr(((a - M(c, 1)) ^ 2) + ((b - M(c, 2)) ^ 2) + 1)


    Next c

    PSet (a, b), RGB(G(1), G(2), G(3)) 'piiretään piste värien sähkökenttien voimakkuuksien mukaan

Next a
Next b

End Sub

Private Sub Command2_Click()

'arvotaan metapallot

For a = 1 To 8
Form1.Circle (M(a, 1), M(a, 2)), M(a, 3) / 100, Point(M(a, 1), M(a, 2))
    M(a, 1) = Int(Rnd * 400) + 1    'x
    M(a, 2) = Int(Rnd * 300) + 1    'y
    M(a, 3) = Int(Rnd * 3000) + 500   'koko
    M(a, 4) = Int(Rnd * 3) + 1       'väri
Form1.Circle (M(a, 1), M(a, 2)), M(a, 3) / 100, QBColor(QB(M(a, 4)))
Next a

End Sub

Private Sub Command3_Click()

Form1.Cls

End Sub

Private Sub Form_Load()

Randomize

'värit
QB(1) = 12
QB(2) = 10
QB(3) = 9

ch = 1

Call Command2_Click

'helpotetaan käyttäjän elämää :)
Command1.Caption = "RENDER": Command1.Left = 8: Command1.Top = 320: Command1.Width = 129: Command1.Height = 57
Command2.Caption = "RANDOM": Command2.Left = 320: Command2.Top = 320: Command2.Width = 73: Command2.Height = 25
Command3.Caption = "CLEAR": Command3.Left = 320: Command3.Top = 352: Command3.Width = 73: Command3.Height = 25
HScroll1.Left = 144: HScroll1.Top = 320: HScroll1.Width = 105: HScroll1.Height = 25: HScroll1.Value = 1: HScroll1.Max = 8: HScroll1.Min = 1
HScroll2.Left = 144: HScroll2.Top = 352: HScroll2.Width = 105: HScroll2.Height = 25: HScroll2.Value = 1000: HScroll2.Max = 20000: HScroll2.Min = 0
Text1.Text = 1: Text1.Left = 256: Text1.Top = 320: Text1.Width = 57: Text1.Height = 25: Text1.Locked = True
Text2.Text = 1000: Text2.Left = 256: Text2.Top = 352: Text2.Width = 57: Text2.Height = 25: Text2.Locked = True

End Sub

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

If Button = 1 Then    'vasen nappi  (vaihdetaan valitun metapallon paikaa)
Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, Point(M(ch, 1), M(ch, 2))

M(ch, 1) = X
M(ch, 2) = Y

For a = 1 To 8
    Form1.Circle (M(a, 1), M(a, 2)), M(a, 3) / 100, QBColor(QB(M(a, 4)))
Next a
End If

If Button = 2 Then   'oikea nappi  (vaihdetaan valitun metapallon väriä)
M(ch, 4) = M(ch, 4) + 1
If M(ch, 4) = 4 Then M(ch, 4) = 1
Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, QBColor(QB(M(ch, 4)))
End If

End Sub

Private Sub HScroll1_Change()

'vaihdetaan valittua metapalloa

Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, QBColor(QB(M(ch, 4)))

Text1.Text = HScroll1.Value
ch = HScroll1.Value

Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, 0

End Sub

Private Sub HScroll2_Change()

'vaihdetaan valitun metapallon kokoa

Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, Point(M(ch, 1), M(ch, 2))

Text2.Text = HScroll2.Value
M(ch, 3) = HScroll2.Value

Form1.Circle (M(ch, 1), M(ch, 2)), M(ch, 3) / 100, 0

End Sub

Kommentit

Antti Laaksonen [21.05.2004 23:28:26]

Lainaa #

Hyvää työtä kaikin puolin!

T.M. [22.05.2004 02:11:45]

Lainaa #

exeä kiitos.

hunajavohveli [23.05.2004 09:43:33]

Lainaa #

Itse en voi pistää Exeä, kun on vain VB5, mutta jos joku tahtoo, niin aivan vapaasti voi tehdä tuosta Exen nettiin. Jos muuten käytette VB3:a, niin tuon pitäisi toimia silläkin, kunhan pistää Form_Load-proseduurin alkuun Form1.Show, poistaa ne Locked-kohdat, joista VB valittaa, ja vaihtaa Static niiden Dim-käskyjen kohdalle, joista valittaa.