Koodit: VB.NET: Vesi

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class frmWater
    Inherits System.Windows.Forms.Form

    ' yleisiä muuttujia
    Private bmp As Bitmap
    Private waves As Long(,,)
    Private bmpWidth As Integer
    Private bmpHeight As Integer
    Private activeBuffer As Integer = 0
    Private weHaveWaves As Boolean
    Private bmpBytes As Byte()
    Private bmpBitmapData As BitmapData

    ' asettaa pisaran säteen
    Private dropRadius As Integer = 5

    ' Kuinka kauan aallot säilyvät. Mitä isompi arvo, sitä kauemmin aallot kestävät
    Private dampener As Integer = 3
    Dim fps As Integer

    Dim fnt As New Font("Arial", 10)

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Haluamme piirtää itse -> ei automaattipäivitystä
        SetStyle(ControlStyles.UserPaint, True)
        'Piirto tapahtuu vain ja ainoastaan paint metodissa
        SetStyle(ControlStyles.AllPaintingInWmPaint, True)
        'Haluamme käyttää myös kaksoispuskurointia
        SetStyle(ControlStyles.DoubleBuffer, True)

    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.
    Friend WithEvents EffectTimer As System.Windows.Forms.Timer
    Friend WithEvents picSurface As System.Windows.Forms.PictureBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Me.EffectTimer = New System.Windows.Forms.Timer(Me.components)
        Me.picSurface = New System.Windows.Forms.PictureBox
        Me.SuspendLayout()
        '
        'EffectTimer
        '
        Me.EffectTimer.Enabled = True
        Me.EffectTimer.Interval = 1
        '
        'picSurface
        '
        Me.picSurface.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
                    Or System.Windows.Forms.AnchorStyles.Left) _
                    Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
        Me.picSurface.Location = New System.Drawing.Point(0, 0)
        Me.picSurface.Name = "picSurface"
        Me.picSurface.Size = New System.Drawing.Size(448, 368)
        Me.picSurface.TabIndex = 0
        Me.picSurface.TabStop = False
        '
        'frmWater
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(448, 366)
        Me.Controls.Add(Me.picSurface)
        Me.Name = "frmWater"
        Me.Text = "Water"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub frmWater_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' Ladataan bittikartta
        bmp = New Bitmap("C:/koe.jpg")
        ' otetaan ylös arvot(lukeminen suoraan muuttujasta nopeampaa)
        bmpHeight = bmp.Height
        bmpWidth = bmp.Width
        ' alustetaan aaltotaulukko
        ReDim Me.waves(bmpWidth, bmpHeight, 2)
        ' hankitaan bittikartta dataa(NOPEA TAPA!!!)
        ReDim Me.bmpBytes(bmpWidth * bmpHeight * 4)
        bmpBitmapData = bmp.LockBits(New Rectangle(0, 0, bmpWidth, bmpHeight), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
        Marshal.Copy(bmpBitmapData.Scan0, bmpBytes, 0, bmpWidth * bmpHeight * 4)
    End Sub

    Private Sub ProcessWaves()
        Dim wavesFound As Boolean = False
        Dim x, y As Integer
        Dim newBuffer As Integer

        If (activeBuffer = 0) Then
            newBuffer = 1
        Else
            newBuffer = 0
        End If
        x = 1
        Do While (x < (bmpWidth - 1))
            y = 1
            Do While (y < (bmpHeight - 1))
                ' aalto filtterin "kaava"
                waves(x, y, newBuffer) = CInt((waves(x - 1, y - 1, activeBuffer) + _
                      waves(x, y - 1, activeBuffer) + _
                      waves(x + 1, y - 1, activeBuffer) + _
                      waves(x - 1, y, activeBuffer) + _
                      waves(x + 1, y, activeBuffer) + _
                      waves(x - 1, y + 1, activeBuffer) + _
                      waves(x, y + 1, activeBuffer) + _
                      waves(x + 1, y + 1, activeBuffer) >> 2) - waves(x, y, newBuffer))

                'pehmennys(jotta aallot joskus häviäisivät :D)
                If Not (waves(x, y, newBuffer) = 0) Then
                    waves(x, y, newBuffer) -= CInt(waves(x, y, newBuffer) >> dampener)
                    wavesFound = True ' Jos tänne on päästy(ks. iffi) niin aaltoja (vielä) on
                End If
                y += 1
            Loop 'y++
            x += 1
        Loop 'x++
        weHaveWaves = wavesFound
        activeBuffer = newBuffer
    End Sub

    Private Sub picSurface_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles picSurface.Paint
        Dim tmp As Bitmap = bmp.Clone()
        Dim x, y As Integer
        Dim xOffset, yOffset As Integer
        Dim alpha As Integer

        If (weHaveWaves) Then
            Dim tmpData As BitmapData = tmp.LockBits(New Rectangle(0, 0, bmpWidth, bmpHeight), ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
            Dim tmpBytes(bmpWidth * bmpHeight * 4) As Byte
            Marshal.Copy(tmpData.Scan0, tmpBytes, 0, bmpWidth * bmpHeight * 4)

            x = 1
            Do While (x < (bmpWidth - 1))
                y = 1
                Do While (y < (bmpHeight - 1))
                    'tsekkaa törmäilyt
                    If (x <= 0) Then
                        x = 1
                    ElseIf (x >= bmpWidth - 1) Then
                        x = bmpWidth - 2
                    End If
                    If (y <= 0) Then
                        y = 1
                    ElseIf (y >= bmpHeight - 1) Then
                        y = bmpHeight - 2
                    End If
                    'Tämä on johdettu raytracingistä(AH!) heijastetaan oikea pikseli siten,
                    'että saadaan aikaan valoa taittava efekti.
                    xOffset = waves(x - 1, y, activeBuffer) - waves(x + 1, y, activeBuffer) >> 3
                    yOffset = waves(x, y - 1, activeBuffer) - waves(x, y + 1, activeBuffer) >> 3
                    If ((Not (xOffset = 0)) Or (Not (yOffset = 0))) Then
                        'tsekkaa törmailyt(heijastetuille pikseleille)
                        If (x + xOffset >= bmpWidth - 1) Then xOffset = bmpWidth - x - 1
                        If (x + xOffset < 0) Then xOffset = -x

                        If (y + yOffset >= bmpHeight - 1) Then yOffset = bmpHeight - y - 1
                        If (y + yOffset < 0) Then yOffset = -y
                        'luodaan alpha
                        alpha = CInt(200 - xOffset)
                        If (alpha < 0) Then
                            alpha = 0
                        ElseIf (alpha > 255) Then
                            alpha = 254
                        End If
                        'asetetaan värit oikeisiin kohtiin(napataan oikeasta kohdasta bittitaulukkoa)
                        tmpBytes(4 * (x + y * bmpWidth)) = bmpBytes(4 * (x + xOffset + (y + yOffset) * bmpWidth))
                        tmpBytes(4 * (x + y * bmpWidth) + 1) = bmpBytes(4 * (x + xOffset + (y + yOffset) * bmpWidth) + 1)
                        tmpBytes(4 * (x + y * bmpWidth) + 2) = bmpBytes(4 * (x + xOffset + (y + yOffset) * bmpWidth) + 2)
                        tmpBytes(4 * (x + y * bmpWidth) + 3) = alpha
                    End If
                    y += 1
                Loop 'y
                x += 1
            Loop 'x
            'kopioidaan data takasin
            Marshal.Copy(tmpBytes, 0, tmpData.Scan0, bmpWidth * bmpHeight * 4)
            tmp.UnlockBits(tmpData)
        End If
        e.Graphics.DrawImage(tmp, 0, 0, picSurface.ClientRectangle.Width, picSurface.ClientRectangle.Height)
        e.Graphics.DrawString("fps: " & fps, fnt, Brushes.Black, 50, 50)
    End Sub

    Private Sub PutDrop(ByVal x As Integer, ByVal y As Integer, ByVal height As Short)
        ' Simuloi pyöreää pisaraa
        ' täyttää aaltotaulukon sopivilla arvoilla
        ' Käytetään hyväksi kosiniaaltoa
        ' (Jos tykkäät geomatriasta/algebrasta RAKASTAT tätä aliohjelmaa
        ' Silloin tulet nauttimaan myös renderöinnin "raytracing" osuudesta)

        ' Nyt meillä ON aaltoja :D
        weHaveWaves = True
        Dim radius As Integer = dropRadius
        'etäisyyden neliö
        Dim distSquared As Double
        'aloitetaan "pallon" reunoilta
        Dim i As Integer = -radius
        Dim tmpX, tmpY As Integer

        Do While (i <= radius)
            Dim j As Integer = -radius
            Do While (j <= radius)
                tmpX = x + i
                tmpY = y + j
                If (((tmpX >= 0) And (tmpX < bmpWidth - 1)) And ((tmpY >= 0) And (tmpY < bmpHeight - 1))) Then
                    ' i:n ja j:n välisen etäisyyden neliö
                    distSquared = Math.Sqrt(i * i + j * j)
                    ' jos etäisyys on < säde silloin aalto "oikein"
                    If (distSquared < radius) Then
                        ' pistetään kosiniaaltoa silmukan osoittamaan paikkaan
                        waves(x + i, y + j, activeBuffer) = CShort(Math.Cos(distSquared * Math.PI / radius) * height)
                    End If
                End If
                j += 1
            Loop 'j
            i += 1
        Loop 'i
    End Sub

    Private Sub picSurface_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picSurface.MouseMove
        ' Koska bittikarttaa skaalataan, täytyy hiiren koordinaatteja hieman säätää...
        Dim realX As Integer = CInt((e.X / CDbl(picSurface.ClientRectangle.Width)) * bmpWidth)
        Dim realY As Integer = CInt((e.Y / CDbl(picSurface.ClientRectangle.Height)) * bmpHeight)
        PutDrop(realX, realY, 200)
    End Sub

    Private Sub frmWater_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
        Do
            Dim d As Long = Now().Millisecond
            Dim ft As Long
            ' jos aaltoja -> piirretään
            If weHaveWaves Then
                picSurface.Invalidate()
                ProcessWaves()
            End If
            If Int(Rnd() * 100) > 70 Then
                PutDrop(Int(Rnd() * bmpWidth), Int(Rnd() * bmpHeight), Int(Rnd() * 100) + 100)
            End If
            Application.DoEvents()
            ft = Now().Millisecond - d
            fps = 1 / ft * 1000
        Loop
    End Sub

    Private Sub frmWater_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
        End
    End Sub
End Class