Plasmaefekti.Flipcodessa oli kiva teksti, joka käsitteli plasmaa.
Sen ansiosta hoksasin, miten plasma toimii.
Ensin lasketaan jokaiselle pikselille voimakkuus, jonka jälkeen paletin avulla asetetaan niille värit.
Koodin pitäisi kääntyä sekä 2002 versiolla, että 2003 versiolla visual basicista. Varma en kuitenkaan ole.
Tämän koodin voi ajaa lataamatta sitä koneelle, sillä se ei tarvitse mitään ylimääräisiä linkkejä(ks. Vesi ja Linssi).
Exe löytyy: http://koti.mbnet.fi/peku1/Plasma.exe
Myönnän, että koodi on hidas, mutta en voi sille mitään.
En pystynyt myöskään soveltamaan bittikartan pikseleiden asettamista lockin ja marshalin copyn avulla(kuten Linssissä ja Vedessä).
Public Class frmPlasma
Inherits System.Windows.Forms.Form
Dim bmp As Bitmap
Dim func1(,) As Integer
Dim func2(,) As Integer
Dim palette(255) As Color
Dim t As Long
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
End Sub
'Form overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
'
'frmPlasma
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(378, 336)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Name = "frmPlasma"
Me.Text = "Plasma"
End Sub
#End Region
Private Sub frmPlasma_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' luodaan bittikartta
bmp = New Bitmap(Me.Width, Me.Height)
' alustetaan funktio taulukot
ReDim func1(Me.Width, Me.Height)
ReDim func2(Me.Width, Me.Height)
Dim i, j As Integer
For i = 0 To Me.Width
For j = 0 To Me.Height
func1(i, j) = 64 + 63 * Math.Sin(i / (37 + 10 * Math.Cos(j / 24))) * Math.Cos(j / (31 + 21 * Math.Sin(i / 37)))
func2(i, j) = 64 + 63 * Math.Sin(i / (37 + 15 * Math.Cos(j / 74))) * Math.Cos(j / (31 + 11 * Math.Sin(i / 57)))
Next
Next
'alustetaan paletti
For i = 0 To 255
palette(i) = Color.FromArgb(72 + 71 * Math.Cos(i * Math.PI / 128 + j / 74), (72 + 71 * Math.Sin(i * Math.PI / 128 + j / 63)), (72 - 71 * Math.Cos(i * Math.PI / 128 + j / 81)))
Next
End Sub
Private Function hypot(ByVal val1 As Integer, ByVal val2 As Integer)
Return (val1 * val1 + val2 * val2)
End Function
Private Sub frmPlasma_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
Dim x, y As Integer
Dim d As Long
Dim Values(Me.Width, Me.Height) As Integer
t += 20
Dim i As Integer
For i = 0 To 255
palette(i) = Color.FromArgb(72 + 71 * Math.Cos(i * Math.PI / 128 + t / 74), (72 + 71 * Math.Sin(i * Math.PI / 128 + t / 63)), (72 - 71 * Math.Cos(i * Math.PI / 128 + t / 81)))
Next
For x = 1 To bmp.Width - 1
For y = 1 To bmp.Height - 1
Values(x, y) = func1(x, y) + func2(x, y)
If Values(x, y) > 255 Then Values(x, y) = 255
bmp.SetPixel(x, y, palette(Values(x, y)))
Next
Next
Me.BackgroundImage = bmp
End Sub
Private Sub frmPlasma_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
While 1 = 1
Me.Refresh()
Application.DoEvents()
End While
End Sub
Private Sub frmPlasma_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
End
End Sub
End ClassKAUNIS!!...missä sä oikein opit noi kaikki jutut?
Hienohan tuo on!
Kuten Peki sanoi tuo on hidas. Olen nähnyt QB:llä nopeamman.
Nooh, enpä tiedä tuliko paljoa nopeampi. Paletti päivittyy vain hiirtä liikkuttamalla ja kirjoitusvirheentakia kuvasta tuli vähän erillainen. (ja korjasin muunnosvirheestä syntyneet kuvavirheet)
Option Strict On
Public Class frmPlasma
Inherits System.Windows.Forms.Form
Dim bmp As Bitmap
Dim Values(,) As Byte 'Tähän tallennetaan laskettu taulukko
Dim t As Long 'Värilikua kuvaava paikka
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
End Sub
'Form overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
'
'frmPlasma
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(378, 336)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Name = "frmPlasma"
Me.Text = "Plasma"
End Sub
#End Region
Private Sub frmPlasma_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim X As Integer
Dim Y As Integer
' luodaan bittikartta
bmp = New Bitmap(Me.Width, Me.Height)
ReDim Values(Me.Width, Me.Height)
'Lasketaan taulukko
For X = 0 To Me.Width
For Y = 0 To Me.Height
Values(X, Y) = CByte(64 + 63 * Math.Sin(X / (37 + 10 * Math.Cos(Y / 24)) * Math.Cos(Y / (31 + 21 * Math.Sin(X / 37)))) + 64 + 63 * Math.Sin(X / (37 + 15 * Math.Cos(Y / 74))) * Math.Cos(Y / (31 + 11 * Math.Sin(X / 57))))
'Alkup. kuva = CByte(64 + 63 * Math.Sin(x / (37 + 10 * Math.Cos(y / 24))) * Math.Cos(y / (31 + 21 * Math.Sin(x / 37)))) + (64 + 63 * Math.Sin(x / (37 + 15 * Math.Cos(y / 74))) * Math.Cos(y / (31 + 11 * Math.Sin(x / 57))))
Next
Next
End Sub
Private Sub PaivitaRuutu()
Dim Paletti(255) As Color
Dim X, Y As Integer
't += 20
'Lasketaan paletti
For X = 0 To 255
Paletti(X) = Color.FromArgb(CInt(72 + 71 * Math.Cos(X * Math.PI / 128 + t / 74)), (CInt(72 + 71 * Math.Sin(X * Math.PI / 128 + t / 63))), (CInt(72 - 71 * Math.Cos(X * Math.PI / 128 + t / 81))))
Next
'Päivitetään paletti valmiiksi lasketun taulukon mukaan
For X = 1 To bmp.Width - 1
For Y = 1 To bmp.Height - 1
bmp.SetPixel(X, Y, Paletti(Values(X, Y)))
Next Y
Next X
Me.BackgroundImage = bmp
End Sub
Private Sub frmPlasma_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
PaivitaRuutu()
While 1 = 1
'Me.Refresh()
Application.DoEvents()
End While
End Sub
Private Sub frmPlasma_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
t = e.X + (e.Y * 10) 'Päivitetään värit hiiren mukaan
PaivitaRuutu()
Me.Refresh()
End Sub
Private Sub frmPlasma_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
End
End Sub
End ClassTää mun kone ei tykkää kun koitan ajaa binaryn:
"Please set registry key HKLM\Software\Microsoft\.NETFramework\
Uijui peki vähän sä oot PRO!
Hieno hei! Vanhaa tietoa, mutta sä olet PR0! :P
Gwaur: sulta puuttu framework. sen saa ladattu microsoftin sivuilta (n. 100 megaa)
lainaus:
Gwaur: sulta puuttu framework. sen saa ladattu microsoftin sivuilta (n. 100 megaa)
Et tarvitse tuota sadan mekan sdk pakettia!
Lataa 23 megan redistributable (meniköhän oikein =D) frameworkki. Se käy yhtä hyvin sovellusten ajamiseen.
Kattoisin ton kanssa mutta Wintoosa vinee jtn eikä ohjelma mene päälle enkä taas jaksa asentaa mitään :/
Ihan hieno mut aika hidas kyl
lainaus:
lainaus:
Gwaur: sulta puuttu framework. sen saa ladattu microsoftin sivuilta (n. 100 megaa)
Et tarvitse tuota sadan mekan sdk pakettia!
Lataa 23 megan redistributable (meniköhän oikein =D) frameworkki. Se käy yhtä hyvin sovellusten ajamiseen.
mäki haluisin ton 23 mekan :P paketin -- mistä?
tämän linkin olen jo laittanut putkaan 5 kertaa(eli nyt 6) :D
apua! miten toi sammuu?? suoritinkäyttökin on sadassa prosentissa.
hmm.
Tuon pitäisi sammua ihan normaalisti painamalla sitä pikku ruksia. :P
Jos se ei siten sammu, mene task manageriin ja tapa sieltä prosesseista plasma.exe.
Loistava!
Bugi! Maksimoi ikkuna koko näyttöön niin näet!
Aihe on jo aika vanha, joten et voi enää vastata siihen.