Page 1 of 1

Dazzling Program With Timer And Shifting Texture Rate Topic: -----

#1 ricardosms  Icon User is offline

  • D.I.C Regular
  • member icon

Reputation: 73
  • View blog
  • Posts: 301
  • Joined: 02-April 10

Posted 12 March 2012 - 05:32 AM

Dazzling Program With Timer And Shifting Texture


Hello Everyone!

This program is a derivative work from another program I am working on.

Here I have produced some animation with the use of a timer to shift a pattern over an image. Maybe not too useful, but it has some programming tricks that may be of use for someone.

.Random Values
.List(Of Label)
.Lockbits
.GetPixel(), SetPixel()
.Loops
.Array shifting
.Timer
.String operation
.Control's properties(Name,BackColor)
.If branching, depending on set conditions
.Resizing
.Image format conversion


The idea is to manually create a pattern on the grid of labels shown, transform it into a two dimension boolean array or randomly generating the array. Then applying this array of values to an image, to generate another modified image, and then shifting the values on the array and applying the array to the image again. This is done with a timer, so it shows a fast changing patterns over the image, somehow like those ancient "Sci-Fi" movies when the computer wizzard was doing some communications with the extraterrestrials.

The pattern is duplicated and mirrored horizontally with another array, so the dazzling effect is somehow symmetrical on a vertical line for every 12 pixels.

Initially I have set a simple pattern, so the picturebox doesn't become black if you press the start button without generating a pattern. In this case the pattern will shift left one column at the time and show the process on the label's grid and on the image. The pattern will appear black. If you press the checkbox with the half moon icon, it will use the complimentary color, white. If you use the color picker image, you will use that color or the complimentary color, depending on the checkbox selection.


Attached Image


If you click the button showing the dice, a random pattern is created and will be used. If you instead click on the grid of labels, the one clicked at will change color, and a new pattern will be created. You can manually shift up and left this pattern using the chevrons buttons. On doing this the pattern will change too.

The start and stop buttons will start and stop the timer, so the dazzling effect starts or stops.

The numeric up-down has a label on top, so it shows decimal numbers instead of integers, this way I can enlarge the resulting image on fractionary increases instead of doubling or trippling on one shot. The Maximum value for the numeric up-down is 400, the minimum is 100, the initial value is 300 and the increment is 25. These values are divided by 100 to get the decimal value on the label and on the magnification of the image.

The working image is hidding under the resulting image and is set to invisible. This way we are always working on the original image and not on the generated one. Here is where you load your own images. You could load them from the menu. If the image is too large you could change the numeric up-down to a smaller value.

Ready?
OK, here we go!


Importing libraries and setting variables:

#Region "Imports"
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Collections
Imports System.Collections.Specialized

'36 Squares >> 2^36 = 68,719,476,736 Patterns Multiplied by Other Modifications

#End Region

Public Class Form1
#Region "Global Variables"
    Dim Mag As Single = 1.0 'To enlarge image
    Dim WorkImg As Image 'Image To Transform
    Dim PX(5, 5), PXInvert(5, 5) As Boolean 'Six Pixel For Side To Pattern Unit
    Dim Labels As New List(Of Label)  'To keep the labels
    Dim MyColor As Color = Color.Black 'Pattern color
#End Region



Set initial values conditions and tooltips:

#Region "Load"

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        'Create ToolTips
        ToolTip1.SetToolTip(pbPicker, "Texture Color")
        ToolTip1.SetToolTip(btnStart, "Start Animation")
        ToolTip1.SetToolTip(btnStop, "Stop Animation")
        ToolTip1.SetToolTip(btnShift, "Cycless Pattern Left")
        ToolTip1.SetToolTip(btnScrll, "Cycless Pattern Up")
        ToolTip1.SetToolTip(btnGenerate, "Create New Pattern")
        ToolTip1.SetToolTip(plCreatedPattern, "Pixel Assignment Random Or Manual")
        ToolTip1.SetToolTip(numSize, "Magnification Of Output Image")
        ToolTip1.SetToolTip(lblMask, "Magnification Of Output Image")
        ToolTip1.SetToolTip(plCreatedPattern, "Manually Created Or Random Pattern")
        ToolTip1.SetToolTip(cbBlackWhite, "Switch From White/Black Texture")

        'Add Labels To List
        Labels.Add(Label1)
        Labels.Add(Label2)
        Labels.Add(Label3)
        Labels.Add(Label4)
        Labels.Add(Label5)
        Labels.Add(Label6)
        Labels.Add(Label7)
        Labels.Add(Label8)
        Labels.Add(Label9)
        Labels.Add(Label10)
        Labels.Add(Label11)
        Labels.Add(Label12)
        Labels.Add(Label13)
        Labels.Add(Label14)
        Labels.Add(Label15)
        Labels.Add(Label16)
        Labels.Add(Label17)
        Labels.Add(Label18)
        Labels.Add(Label19)
        Labels.Add(Label20)
        Labels.Add(Label21)
        Labels.Add(Label22)
        Labels.Add(Label23)
        Labels.Add(Label24)
        Labels.Add(Label25)
        Labels.Add(Label26)
        Labels.Add(Label27)
        Labels.Add(Label28)
        Labels.Add(Label29)
        Labels.Add(Label30)
        Labels.Add(Label31)
        Labels.Add(Label32)
        Labels.Add(Label33)
        Labels.Add(Label34)
        Labels.Add(Label35)
        Labels.Add(Label36)

 

        ' Assign Initial Values

        WorkImg = Work.Image.Clone
        For m As Integer = 0 To 5
            For n As Integer = 0 To 5
                PX(n, m) = True
                PXInvert(n, m) = True
            Next
        Next
        PX(0, 4) = False
        PX(1, 4) = False
        PX(2, 4) = False
        PX(3, 3) = False
        PX(4, 2) = False
        PXInvert(0, 2) = False
        PXInvert(1, 2) = False
        PXInvert(2, 2) = False
        PXInvert(3, 3) = False
        PXInvert(4, 4) = False
    End Sub

#End Region



If you want to use your own image, we load it and convert to RGB, so indexed images won't fail.


#Region "Open And Prepare"
    Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 

OpenToolStripMenuItem.Click

        Dim f As New OpenFileDialog
        Try
            With f
                .Filter = "Image Files|*.bmp;*.gif;*.jpg;*.png;*.tif"
                .Multiselect = True
                If .ShowDialog = DialogResult.OK Then
                    Work.Image = ConvertToRGB(Image.FromFile(.FileName))
                    Cross.Image = ConvertToRGB(Image.FromFile(.FileName))

                    Me.Text = "Create Pattern -> " & .FileName.Substring(.FileName.LastIndexOf("\") + 1)
                End If
            End With

        Catch ex As Exception
            MsgBox(ex.ToString)

        Finally
            If Not f Is Nothing Then
                f.Dispose()
                f = Nothing
            End If
        End Try
        Cross.Size = Work.Size

    End Sub

    Public Shared Function ConvertToRGB(ByVal original As Bitmap) As Bitmap

        'Eliminate Problems With Indexed Images

        Dim newImage As New Bitmap(original.Width, original.Height, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
        newImage.SetResolution(original.HorizontalResolution, original.VerticalResolution)
        Dim g As Graphics = Graphics.FromImage(newImage)
        g.DrawImageUnscaled(original, 0, 0)
        g.Dispose()
        Return newImage
    End Function

#End Region




Here we create and manipulate the pattern, "btnGenerate" will create two arrays of boolean values, one mirroring the other.

#Region "Change Values"

    Private Sub btnGenerate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGenerate.Click
        'Generate Random Numbers To Assign True or False To The Pixel Positions

        For m As Integer = 0 To 5
            For n As Integer = 0 To 5
                PX(n, m) = RandomValue(0, 15) 'For True Or False Values
                PXInvert(n, 5 - m) = PX(n, m)
            Next
        Next

        ' Display Position Colors On Panel, 36 Of Them.
        AssignColor()
        MakePattern()
    End Sub
    Private Sub cbInvert_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
        MakePattern()
    End Sub



Or manually modify or construct the pattern by clicking the labels on the grid:


    Private Sub Label1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles _
        Label1.Click, Label2.Click, Label3.Click, Label4.Click, Label5.Click, _
        Label6.Click, Label7.Click, Label8.Click, Label9.Click, Label10.Click, _
        Label11.Click, Label12.Click, Label13.Click, Label14.Click, Label15.Click, _
        Label16.Click, Label17.Click, Label18.Click, Label19.Click, Label20.Click, _
        Label21.Click, Label22.Click, Label23.Click, Label24.Click, Label25.Click, _
        Label26.Click, Label27.Click, Label28.Click, Label29.Click, Label30.Click, _
        Label31.Click, Label32.Click, Label33.Click, Label34.Click, Label35.Click, Label36.Click

        'Identify label that was clicked

        Dim Num, p, q As Integer
        Num = Val(sender.name.substring(5))
        p = (Num - 1) \ 6
        q = (Num - 1) Mod 6

        'And change color

        If sender.backcolor = Color.Red Then
            sender.backcolor = Color.Black
            ' PX(p, q) = True
        Else
            sender.backcolor = Color.Red
            ' PX(p, q) = False
        End If
        'And redo the array values

        For i = 0 To 35  
            If Labels(i).BackColor = Color.Black Then
                PX((i \ 6), (i Mod 6)) = True
                PXInvert((i \ 6), 5 - (i Mod 6)) = True
            Else
                PX((i \ 6), (i Mod 6)) = False
                PXInvert((i \ 6), 5 - (i Mod 6)) = False
            End If
        Next
    End Sub



'If we want to invert the color of the pattern:


    Private Sub cbBlackWhite_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 

cbBlackWhite.CheckedChanged
        MakePattern()
    End Sub



In the "MakePattern" routine it will branch on a if condition.

Resizing the image goes with these routines:


    Public Function RSize(ByVal OrigImg As Image, ByVal XSize As Single) As Image 'Integer) As Image
        ' Enlarge Output Image.
        Dim imgFormat = OrigImg.RawFormat

        'Create Bitmap from the image
        Dim imgOutput As New Bitmap(OrigImg, XSize * Work.Width, XSize * Work.Height)

        'Create a Graphics object
        Dim GResize As Graphics
        GResize = Graphics.FromImage(imgOutput)
        'Set the image to high quality
        GResize.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        GResize.DrawImage(OrigImg, 0, 0, XSize * Work.Width, XSize * Work.Height)

        GResize.Dispose()

        Return imgOutput

    End Function

    Private Sub numSize_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles numSize.ValueChanged

        Mag = numSize.Value / 100
        lblMask.Text = Mag.ToString
    End Sub



Here is the random function to assign the array values:


    Public Function RandomValue(ByVal low As Integer, ByVal high As Integer) As Boolean
        Static Random1 As New Random
        If Random1.Next(low, high + 2) Mod 2 = 0 Then
            Return False
        Else
            Return True
        End If
    End Function



The manual and timed array shifting is done in this routine:


    Private Sub btnShift_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnShift.Click, btnScrll.Click
        Dim PXTemp(5, 5) As Boolean
        For Each Lab As Label In plCreatedPattern.Controls
            Lab.BackColor = Color.Black
        Next

        If sender Is btnShift Then

            For f As Integer = 0 To 5
                For g As Integer = 0 To 4
                    PXTemp(f, g) = PX(f, g + 1)
                Next
                PXTemp(f, 5) = PX(f, 0)
            Next

            For f As Integer = 0 To 5
                For g As Integer = 0 To 5
                    PX(f, g) = PXTemp(f, g)
                    PXInvert(f, 5 - g) = PX(f, g)
                Next
            Next

        End If

        If sender Is btnScrll Then

            For g As Integer = 0 To 5
                For f As Integer = 0 To 4
                    PXTemp(f, g) = PX(f + 1, g)
                Next
                PXTemp(5, g) = PX(0, g)
            Next
            For f As Integer = 0 To 5
                For g As Integer = 0 To 5
                    PX(f, g) = PXTemp(f, g)
                    PXInvert(f, 5 - g) = PX(f, g)
                Next
            Next

        End If
        AssignColor()
        MakePattern()
    End Sub



Which calls "AssignColor" and "MakePattern", that are for displaying and to apply the pattern.

For selecting a color, we create a bitmap from the color picker image and use "Getpixel()" on "Mouseclick" handler. This color is split on the RGB components in the "MakePattern" routine. Then assign them to the individual bytes of the image in a lockbits loop.

    Private Sub pbPicker_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbPicker.MouseClick
        Dim PickColor As New Bitmap(pbPicker.Image)
        MyColor = PickColor.GetPixel(e.X, e.Y)
    End Sub
#End Region



When manually constructing the array, we use the label names, that are sequential, to locate the ones to change color.


#Region "Fill Array"

    Private Sub AssignColor()

        Dim strName As String = ""
        Dim NumName As Integer

        For k As Integer = 0 To 5
            For l As Integer = 0 To 5

                NumName = 6 * k + l + 1
                strName = "Label" & NumName.ToString
                For Each lbl As Object In Labels

                    If lbl.name = strName Then
                        If PX(k, l) Then
                            lbl.BackColor = Color.Black
                        Else
                            lbl.BackColor = Color.Red
                        End If
                    End If
                Next
            Next
        Next
    End Sub

#End Region



And finally, the lockbits process to quickly apply the pattern to the image. The lockbits from the Marshal Class locks an area of the image and works at a byte level instead of a pixel level, and it works much faster than the alternate pixel process. This dazzling effect wouldn't be possible with the "GetPixel" and "SetPixel" functions, because they are very slow processes and the timer would "TicK" before the process has gone over the image, mostly with medium or large images.


#Region "Apply Pattern"
    Private Sub MakePattern()
        Dim x, y As Integer 'Counters For Lockbits Loops
        WorkImg = Work.Image

        'Transform Image According To Pattern

        Try
            Dim rect As Rectangle = Rectangle.Round(Work.Image.GetBounds(GraphicsUnit.Pixel))
            Dim wid As Integer = Work.Image.Width
            Dim hgt As Integer = Work.Image.Height
            Dim img As New Bitmap(wid, hgt)
            img = WorkImg.Clone

            img = ConvertToRGB(img) ' Make Sure Obtained Image Is On RGB Format.

            'Set The LockBits Variables.

            Dim bmpSr As BitmapData = img.LockBits(New Rectangle(0, 0, img.Width, img.Height), ImageLockMode.ReadWrite, img.PixelFormat)

            Dim ptrSr As IntPtr = bmpSr.Scan0
            Dim R, G, B As Integer ' Positions For The RED, GREEN And BLUE Bytes
            R = 2
            G = 1
            B = 0
            'A = 3
            Dim bytesSr As Integer = bmpSr.Stride * img.Height
            Dim rgbvaluesSr(bytesSr) As Byte
            System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)

            Dim stp As Integer = 6 'Size Of Pixelation
            Dim LastStrip As Integer ' If Image Height Is Not A Multiple Of 6

            'Loop Through The Values.
            Dim Flip As Integer = 1
            Dim flip1 As Integer = 1
            For y = 0 To stp * (img.Height \ stp) - 1 Step stp
                flip1 += 1
                If img.PixelFormat = PixelFormat.Format24bppRgb Then
                    For x = 0 To stp * (bmpSr.Stride \ stp) - 3 * stp Step 3 * stp
                        Flip += 1

                        ' Assign Colors
                        If y < img.Height - 6 Then 'Picture.height is not multiple of 6

                            For k As Integer = 0 To stp - 1
                                If (Flip + flip1) Mod 2 = 0 Then
                                    For l As Integer = 0 To stp - 1
                                        If PX(k, l) Then
                                            'Leave the way it is
                                        Else
                                            If cbBlackWhite.Checked = False Then
                                                rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = MyColor.R
                                                rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = MyColor.G
                                                rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = MyColor.B
                                            Else
                                                rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = 255 - MyColor.R
                                                rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = 255 - MyColor.G
                                                rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = 255 - MyColor.B

                                            End If
                                        End If

                                    Next

                                Else

                                    For l As Integer = 0 To stp - 1
                                        If PXInvert(k, l) Then
                                            'Leave the way it is
                                        Else
                                            If cbBlackWhite.Checked = False Then
                                                rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = MyColor.R
                                                rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = MyColor.G
                                                rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = MyColor.B
                                            Else
                                                rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = 255 - MyColor.R
                                                rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = 255 - MyColor.G
                                                rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = 255 - MyColor.B

                                            End If
                                        End If

                                    Next

                                End If

                            Next


                        Else

                            For k As Integer = 0 To 5 - (img.Height Mod 6)
                                For l As Integer = 0 To stp - 1
                                    If PX(k, l) Then
                                        'Leave the way it is
                                    Else
                                        If cbBlackWhite.Checked = False Then
                                            rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = MyColor.R
                                            rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = MyColor.G
                                            rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = MyColor.B
                                        Else
                                            rgbvaluesSr(y * bmpSr.Stride + x + R + 3 * l + k * bmpSr.Stride) = 255 - MyColor.R
                                            rgbvaluesSr(y * bmpSr.Stride + x + G + 3 * l + k * bmpSr.Stride) = 255 - MyColor.G
                                            rgbvaluesSr(y * bmpSr.Stride + x + B + 3 * l + k * bmpSr.Stride) = 255 - MyColor.B

                                        End If
                                    End If

                                Next
                            Next


                        End If
                    Next x
                    Flip = 1 'To alternate
                Else
                    MessageBox.Show("No Provisions Fot This Format")
                    Exit Sub
                End If
                LastStrip = y + 6
            Next y
            System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)

            img.UnlockBits(bmpSr)
            Cross.Image = RSize(img, Mag)
            Work.Invalidate()
            Dim bmpFromImage As New Bitmap(Work.Width, Work.Height)
            bmpFromImage = Work.Image
            Dim g1 As Graphics = Graphics.FromImage(img)
            g1.DrawImage(bmpFromImage, 0, 0, img.Width, img.Height)
            g1.Dispose()
        Catch ex As Exception

            MessageBox.Show(ex.ToString)
        End Try
    End Sub
#End Region



The timer controls the shifting and application of the pattern, and itself is controlled by the start and stop buttons:


#Region "Animation"
    Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
        Timer1.Start()
    End Sub

    Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
        Timer1.Stop()
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        btnShift.PerformClick()
    End Sub
#End Region
 End Class




Thank you for checking. Attached is project.

regards,
ricardosms

Attached File(s)



Is This A Good Question/Topic? 1
  • +

Replies To: Dazzling Program With Timer And Shifting Texture

#2 ricardosms  Icon User is offline

  • D.I.C Regular
  • member icon

Reputation: 73
  • View blog
  • Posts: 301
  • Joined: 02-April 10

Posted 23 April 2012 - 07:25 PM

Hey!

On my version I have this modified routine, so it also scrolls up:

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Static Up As Integer = 0
        Up += 1
        btnShift.PerformClick()
        If Up Mod 6 = 5 Then btnScrll.PerformClick()
    End Sub



This way it shows several more patterns (You multipy them by 6).
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1