Keskustelu: Koodit: VB.NET: Fault Noise -algoritmi

Public Class frmNoise2
    Inherits System.Windows.Forms.Form

    Dim b As Bitmap

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

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

        'Add any initialization after the InitializeComponent() call

    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 picSurface As System.Windows.Forms.PictureBox
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.picSurface = New System.Windows.Forms.PictureBox
        Me.SuspendLayout()
        '
        'picSurface
        '
        Me.picSurface.Location = New System.Drawing.Point(0, 0)
        Me.picSurface.Name = "picSurface"
        Me.picSurface.Size = New System.Drawing.Size(384, 344)
        Me.picSurface.TabIndex = 0
        Me.picSurface.TabStop = False
        '
        'frmNoise2
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(384, 342)
        Me.Controls.Add(Me.picSurface)
        Me.Name = "frmNoise2"
        Me.Text = "Noise2"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub frmNoise2_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i As Integer
        Dim x, y As Integer
        Dim bi As New Bitmap(picSurface.Width, picSurface.Height)
        Dim g As Graphics
        Randomize()
        g = Graphics.FromImage(bi)
        g.Clear(Color.FromArgb(0, 0, 125))
        g.Dispose()
        Dim d As Double = Math.Sqrt(200 * 200 + 200 * 200)
        For i = 1 To 500
            ' arvotaan suora, joka puolittaa alueen
            Dim v As Double = Rnd() * 2 * Math.PI
            Dim a As Double = Math.Sin(v)
            Dim b As Double = Math.Cos(v)
            ' c:stä saadaan arvottu numero -d/2 ja d/2 väliltä
            Dim c As Double = Rnd() * d - d / 2
            For x = 1 To 200
                For y = 1 To 200
                    ' tarkistetaan, kummalla puolella viivaa piste on
                    If (a * x + b * y - c > 0) Then
                        ' kirkastetaan
                        Dim clr As Integer
                        clr = bi.GetPixel(x, y).B
                        clr += 3
                        If clr > 255 Then clr = 255
                        bi.SetPixel(x, y, Color.FromArgb(0, 0, clr))
                    Else
                        ' tummennetaan
                        Dim clr As Integer
                        clr = bi.GetPixel(x, y).B
                        clr -= 3
                        If clr < 0 Then clr = 0
                        bi.SetPixel(x, y, Color.FromArgb(0, 0, clr))
                    End If
                Next
            Next
        Next
        picSurface.BackgroundImage = bi
    End Sub
End Class

Private Sub frmNoise2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Dim i As Integer
    Dim x, y As Integer
    Dim bi As New Bitmap(picSurface.Width, picSurface.Height)
    Randomize()
    Dim d As Double = Math.Sqrt(200 * 200 + 200 * 200)
    Dim p(200, 200) As Short
    For x = 1 To 200
        For y = 1 To 200
            p(x, y) = 125
        Next
    Next

    For i = 1 To 500
        ' arvotaan suora, joka puolittaa alueen
        Dim v As Double = Rnd() * 2 * Math.PI
        Dim a As Double = Math.Sin(v)
        Dim b As Double = Math.Cos(v)
        ' c:stä saadaan arvottu numero -d/2 ja d/2 väliltä
        Dim c As Double = Rnd() * d - d / 2

        For x = 1 To 200
            For y = 1 To 200
                ' tarkistetaan, kummalla puolella viivaa piste on
                Dim clr = p(x, y)
                If (a * x + b * y - c > 0) Then
                    ' kirkastetaan
                    clr += 3
                    If clr > 255 Then clr = 255
                Else
                    ' tummennetaan
                    clr -= 3
                    If clr < 0 Then clr = 0
                End If
                p(x, y) = clr
            Next
        Next
    Next
    Dim cl(255) As Color
    For i = 0 To 255 : cl(i) = Color.FromArgb(i, i, i) : Next
    For x = 1 To 200
        For y = 1 To 200
            bi.SetPixel(x, y, cl(p(x, y)))
        Next
    Next
    picSurface.BackgroundImage = bi
End Sub