Keskustelu: Koodit: VB.NET: Tekijälista

' tähden tietorakenne
    Private Structure star
        Dim x As Double
        Dim y As Double
        Dim z As Double

        Dim sx As Integer
        Dim sy As Integer

        Dim zv As Double
        Dim b As Integer
    End Structure

    ' tausta puskuri
    Dim b As Bitmap
    ' tausta puskurin graphics olio
    Dim g As Graphics
    ' tekstin sijainti
    Dim pos As Integer = 520

    Dim rect As Rectangle
    Dim stringFormat As New StringFormat
    Dim fnt As Font

    ' tähdet
    Dim stars(99) As Star

    ' Tekijät: tekstin edessä oleva 'R' tarkoittaa tavallista tekstiä, 'B' lihavoitua
    Dim str() As String = {"BProgrammer", "RPeki", "R", "BGraphics", "RGraafikko1", _
    "RGraafikko2", "R", "BDesign", "RDesigneri", "R", "BBetatesters", "RBetaaja1", _
    "RBetaaja2", "RBetaaja3", "R", "RSpecial thanks to Joku and Se", _
    "R- for making this possible", "R", "R", "R" & Chr(169) & " Peki 2003-2004"}

    'alustukset
    Private Sub frmAbout_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i As Integer

        ' alustetaan taustapuskuri ja sen graphics olio
        b = New Bitmap(picSurface.Width, picSurface.Height)
        g = Graphics.FromImage(b)

        ' alustetaan tähdet
        For i = 0 To stars.Length - 1
            stars(i).x = Int(Rnd() * 1000) - 500
            stars(i).y = Int(Rnd() * 1000) - 500
            stars(i).z = Int(Rnd() * 900) + 100

            stars(i).zv = Rnd() * 4.5 + 0.5
        Next

        tmrUpdate.Enabled = True
    End Sub

    Private Sub tmrUpdate_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrUpdate.Tick
        ' countteri
        Dim i As Integer
        ' tähden hännän pituus(kun tähti tulee lähelle, täytyy sitä
        ' pidentää, jotta saadaan aikaan 'MotionBlur' efekti
        Dim length As Integer
        ' tähden sijainti ruudulla
        Dim x, y As Integer
        ' apuarvoja length- muuttujan laskemiseen
        Dim xd, yd As Double
        Dim n As Boolean = False

        ' siirrä tekstiä ylöspäin
        pos -= 2
        If pos <= -520 Then pos = 520

        g.Clear(Color.Black)

        ' liikuta tähtiä
        For i = 0 To stars.Length - 1
            ' siirrä lähemmäs
            stars(i).z -= stars(i).zv

            ' laske sijainti näytöllä
            x = stars(i).x / stars(i).z * 100 + (picSurface.Width / 2)
            y = stars(i).y / stars(i).z * 100 + (picSurface.Height / 2)

            ' Jos tähti ulkona siirrä keskelle
            If stars(i).sx >= picSurface.Width Or stars(i).sx <= 0 _
            Or stars(i).sy >= picSurface.Height Or stars(i).sy <= 0 _
            Or stars(i).z < 1 Then
                stars(i).x = Int(Rnd() * 1000) - 500
                stars(i).y = Int(Rnd() * 1000) - 500
                stars(i).z = Int(Rnd() * 900) + 100

                stars(i).zv = Rnd() * 4.5 + 0.5
            End If

            ' tähden 'pituus' (MotionBlur)
            xd = x - stars(i).sx
            yd = y - stars(i).sy
            length = Math.Sqrt(xd * xd + yd * yd)

            ' kirkkaus
            stars(i).b = (6000 * stars(i).zv) / stars(i).z
            ' jos 'motionblur' käytössa himmennä vähän
            If length > 1 Then stars(i).b = (stars(i).b / (length / 2))

            ' Varmista, että b <= 255
            If stars(i).b > 255 Then stars(i).b = 255

            ' piirrä tähti
            g.DrawLine(New Pen(Color.FromArgb(stars(i).b, Color.White), 2), x, y, stars(i).sx, stars(i).sy)

            ' tallenna koordinaatit
            stars(i).sx = x
            stars(i).sy = y
        Next

        ' Keskitä merkki.
        stringFormat.Alignment = StringAlignment.Center
        ' Keskitä merkki (ylhäältä alas) suorakulmiossa.
        stringFormat.LineAlignment = StringAlignment.Center

        For i = 0 To str.Length() - 1
            ' Tekstin viemä alue
            rect = New Rectangle(0, i * 25 + pos, b.Width, 18)

            ' Jos 'B' lihavoi
            If str(i).Substring(0, 1) = "B" Then
                fnt = New Font("Comic Sans MS", 13, FontStyle.Bold)
            Else
                fnt = New Font("Comic Sans MS", 13, FontStyle.Regular)
            End If
            ' Piirrä
            ' Tuo kirkkaus vaatisi varmaan selvennystä:
            ' |sin(2*pi*rect.y/1040) * (255 / 2)|
            ' kulmahan pitää antaa radiaaneissa(siitä 2*pi*rect.y/1040)
            '
            ' Eli sinikäyrällä saadaan tekstin vuorotellen kirkastumaan
            ' ja himmenemään, kun aallonpituutta säädetään sopivasti
            ' saadaan aikaan kivannäköinen efekti
            g.DrawString(str(i).Substring(1, str(i).Length - 1), fnt, _
            New SolidBrush(Color.FromArgb(Math.Abs(Math.Sin(2 * Math.PI * rect.Y / 1040) * (255 / 2)), Color.White)), _
            RectangleF.op_Implicit(rect), stringFormat)
        Next

        ' näytä taustapuskuri
        picSurface.Image = b
    End Sub