Generate a random black and white   320x240   image continuously,
showing FPS (frames per second).



A sample image
 


Imports System.Drawing.Imaging
 
Public Class frmSnowExercise
    Dim bRunning As Boolean = True
 
    Private Sub Form1_Load(ByVal sender As System.Object,
                           ByVal e As System.EventArgs) Handles MyBase.Load
 
        ' Tell windows we want to handle all the painting and that we want it
        '  to double buffer the form's rectangle (Double Buffering 
        '  removes/ reduces flickering).
        SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint _
            Or ControlStyles.OptimizedDoubleBuffer, True)
        UpdateStyles()
 
        ' Prevent the user from resizing the window. Our draw code is not
        ' setup to recalculate on the fly.
        FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
        MaximizeBox = False
 
        ' The window size and the client rectangle aren't the same.
        ' To get the proper dimensions for our exercise we need to 
        ' figure out the difference and add it to our 320x240 
        ' requirement.
        Width = 320 + Size.Width - ClientSize.Width
        Height = 240 + Size.Height - ClientSize.Height
 
        ' Pop the window, bring it to the front and give windows time to 
        ' reflect the changes.
        Show()
        Activate()
        Application.DoEvents()
 
        ' Hit the loop and keep going until we receive a close request.
        RenderLoop()
 
        ' We're done. Exit the application.
        Close()
 
    End Sub
 
    Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As _
            System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
        ' Close the application when the user hits escape.
        If e.KeyChar = ChrW(Keys.Escape) Then bRunning = False
    End Sub
 
    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As _
            System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        ' We'll cancel the form close request if we're still running so we
        ' don't get an error during runtime and set the close request flag.
        e.Cancel = bRunning
        bRunning = False
    End Sub
 
    Private Sub RenderLoop()
 
        Const cfPadding As Single = 5.0F
 
        Dim b As New Bitmap(ClientSize.Width, ClientSize.Width,
                            PixelFormat.Format32bppArgb)
        Dim g As Graphics = Graphics.FromImage(b)
        Dim r As New Random(Now.Millisecond)
        Dim oBMPData As BitmapData = Nothing
        Dim oPixels() As Integer = Nothing
        Dim oBlackWhite() As Integer = {Color.White.ToArgb, Color.Black.ToArgb}
        Dim oStopwatch As New Stopwatch
        Dim fElapsed As Single = 0.0F
        Dim iLoops As Integer = 0
        Dim sFPS As String = "0.0 FPS"
        Dim oFPSSize As SizeF = g.MeasureString(sFPS, Font)
        Dim oFPSBG As RectangleF = New RectangleF(ClientSize.Width - cfPadding -
                      oFPSSize.Width, cfPadding, oFPSSize.Width, oFPSSize.Height)
 
        ' Get ourselves a nice, clean, black canvas to work with.
        g.Clear(Color.Black)
 
        ' Prep our bitmap for a read.
        oBMPData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height),
                          ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
 
        ' Allocate sufficient space for the pixel data and 
        ' flash copy it to our array.
        ' We want an integer to hold the color for each pixel in the canvas.
        Array.Resize(oPixels, b.Width * b.Height)
        Runtime.InteropServices.Marshal.Copy(oBMPData.Scan0,
                                             oPixels, 0, oPixels.Length)
        b.UnlockBits(oBMPData)
        ' Start looping.
        Do
            ' Find our frame time and add it to the total amount of time 
            ' elapsed since our last FPS update (once per second).
            fElapsed += oStopwatch.ElapsedMilliseconds / 1000.0F
            oStopwatch.Reset() : oStopwatch.Start()
            ' Adjust the number of loops since the last whole second has elapsed
            iLoops += 1
            If fElapsed >= 1.0F Then
                ' Since we've now had a whole second elapse
                ' figure the Frames Per Second, 
                ' measure our string,
                ' setup our backing rectangle for the FPS string
                '        (so it's clearly visible over the snow)
                ' reset our loop counter 
                ' and our elapsed counter.
                sFPS = (iLoops / fElapsed).ToString("0.0") & " FPS"
                oFPSSize = g.MeasureString(sFPS, Font)
                oFPSBG = New RectangleF(ClientSize.Width - cfPadding -
                    oFPSSize.Width, cfPadding, oFPSSize.Width, oFPSSize.Height)
                ' We don't set this to 0 in case our frame time has gone
                '  a bit over 1 second since last update.
                fElapsed -= 1.0F
                iLoops = 0
            End If
 
            ' Generate our snow.
            For i As Integer = 0 To oPixels.GetUpperBound(0)
                oPixels(i) = oBlackWhite(r.Next(oBlackWhite.Length))
            Next
 
            ' Prep the bitmap for an update.
            oBMPData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height),
                       ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
            ' Flash copy the new data into our bitmap.
            Runtime.InteropServices.Marshal.Copy(oPixels, 0, oBMPData.Scan0,
                                                 oPixels.Length)
            b.UnlockBits(oBMPData)
 
            ' Draw the backing for our FPS display.
            g.FillRectangle(Brushes.Black, oFPSBG)
            ' Draw our FPS.
            g.DrawString(sFPS, Font, Brushes.Yellow, oFPSBG.Left, oFPSBG.Top)
 
            ' Update the form's background and draw.
            BackgroundImage = b
            Invalidate(ClientRectangle)
 
            ' Let windows handle some queued events.
            Application.DoEvents()
        Loop While bRunning
 
    End Sub
End Class
 