[ricardosms]

Image Processing. Random Texture Generator. LockBits Pixel Processing.

Hello:

Just to tell you where I am: Vb.net express 2010, Windows 7, screen:1280x960

This Program will take the image on PictureBox1, pixelate it with a random 5X5 Pattern and output the results On Picturebox2.
When the button "Random Pattern" is pressed, there is a random generation of values to assign to the 5x5 grid of pixel values. This pattern is shown on one of the small panels with the 25 black squares on it To the left-top corner. These labels' background color is switched from red to black or vice-versa accorsding to the values obtained. Then this pattern is applied to the image using two nested loops on a lockbits data process.

When done it is assigned to the picturebox2.

If you like a pattern, please save it, we are generating 2^25 (33,554,432) different patterns and probably you won't be able to generate it again if you miss it.





At start the desktop shows two pictureboxes with identical image. Two small panels with red background and black squares on it, a datagridview displaying the saved and available patterns, some other controls and a hidden picturebox.

Here are some examples of random created patterns:









It is a simple process, but it has to be set on the 25 pixel square and then on the image.

As always, Setting the libraries and creating the tooltips and global variables and getting the initial conditions is done on form load.

Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Collections
Imports System.Collections.Specialized

Public Class Form1
    Dim WorkImg As Image 'Image To Transform
    Dim PX(4, 4) As Boolean 'Five Pixel For Side To Pattern Unit
    Dim Pat As String = "" 'For Saving Pattern
    Dim PatnFileNameArray, ImgArray As New ArrayList
    Dim Patterns As Integer = 0
    Private imgSize As Integer = 25 '75
    Dim NewSize As Single = 1.0
    Dim Position As Integer
    Dim W, H, NewWidth, NewHeight As Integer
    Dim Ratio As Single


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Create ToolTips
        ToolTip1.SetToolTip(btnGenerate, "Create New Pattern")
        ToolTip1.SetToolTip(plCreatedPattern, "Pixel Assignment Random Or Manual")
        ToolTip1.SetToolTip(btnSavePattern, "Save Pattern Configuration")
        ToolTip1.SetToolTip(btnSaveImage, "Save Generated Image")
        ToolTip1.SetToolTip(numSize, "Magnification Of Output Image")
        ToolTip1.SetToolTip(plCreatedPattern, "Manually Created Or Random Pattern")
        ToolTip1.SetToolTip(plExistingPattern, "Selected Existing Pattern")
        ToolTip1.SetToolTip(cbManual, "Create Your Own Pattern")
        ToolTip1.SetToolTip(btnManual, "Click CheckBox And Then Click The Pixels" & vbNewLine & "On Pattern Panel View And Then Here" & vbNewLine & "Or Re Process To A Different Size.")
        ToolTip1.SetToolTip(btnFlip, "Mirror Pattern")
        ToolTip1.SetToolTip(btnLeft, "Rotate Pattern 90? Left")
        ToolTip1.SetToolTip(btnRight, "Rotate Pattern 90? Right")
        ToolTip1.SetToolTip(dataVImages, "Existing Patterns")

        dataVImages.DefaultCellStyle.BackColor = Color.RosyBrown
        W = Work.Width
        H = Work.Height
        Ratio = CSng(W / H)
        NewWidth = CInt(400 * Ratio)
        NewHeight = 400
        pbFlash.Height = 400
        pbFlash.Width = NewWidth

        scan()
        FillImages()
        LoadImages()
    End Sub

Not critical, but convenient, the "DragAndDrop" routines. Don't forget to set allowdrop to true on form properties.

    Private Sub Form_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
        Dim strng As String = ""
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then

            Dim Files() As String
            Files = e.Data.GetData(DataFormats.FileDrop)
            strng = Files(0).ToLower
            If strng.Contains(".jpg") Or strng.Contains(".bmp") Or strng.Contains(".png") Or strng.Contains(".gif") Or strng.Contains(".tif") Then


                Dim img As Image
                img = ConvertToRGB(Image.FromFile(Files(0)))
                Work.Image = ConvertToRGB(Image.FromFile(Files(0)))
                Cross.Image = ConvertToRGB(Image.FromFile(Files(0)))
                WorkImg = ConvertToRGB(Image.FromFile(Files(0)))
                W = Work.Image.Width
                H = Work.Image.Height
                Ratio = CSng(W / H)
                NewWidth = CInt(400 * Ratio)
                NewHeight = 400
                pbFlash.Height = 400
                pbFlash.Width = NewWidth
                Me.Text = "FilterColors -> " & Files(0).Substring(Files(0).LastIndexOf("\") + 1)

            Else
                MessageBox.Show("Please Try An Image")

            End If
        End If


    End Sub

    Private Sub Form_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragEnter

        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.All
        End If

    End Sub

Formload calls 3 subroutines: "Scan", "FillImages" and "LoadImages".

Scan will check the application directory for files of type "*.ptn" that are a 25 byte binary files created by this program and containing the configuration of the color and white areas of the texture.

The names of these files are stored in an arraylist, and then a set of bitmaps is created by calling "FillImages" that will read these names from the array, opening and reading the files and setting the pixels on a bitmap. These bitmaps are then stored in another arraylist and loaded onto the datagridview as small images with a call to the subroutine "LoadImages".

    Private Sub scan()
        PatnFileNameArray.Clear()
        Try
            Dim di As New IO.DirectoryInfo(Environment.CurrentDirectory)
            Dim aryFi As IO.FileInfo() = di.GetFiles("*.ptn")
            Patterns = aryFi.Count
            Dim fi As IO.FileInfo
 
            For Each fi In aryFi
                PatnFileNameArray.Add(fi.Name)
            Next
            di = Nothing
            fi = Nothing

            If PatnFileNameArray.Count = 0 Then MessageBox.Show("Didn't Find AnyPpattern Fles In Directory, Sorry")

        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try

    End Sub

    Private Sub FillImages()
        ImgArray.Clear()
        For count As Integer = 0 To PatnFileNameArray.Count - 1

            If PatnFileNameArray IsNot Nothing And PatnFileNameArray.Count <> 0 Then
                Dim Stream As FileStream
                Dim File_Name As String = "" 'PatN()
                Dim CX(4, 4) As Boolean
                Try
                    Stream = New FileStream(PatnFileNameArray(count), FileMode.Open)
                Catch Ex As Exception
                    MessageBox.Show("Error opening " & PatnFileNameArray(count) & Ex.ToString)
                End Try

                Dim BinaryStreamReader As New BinaryReader(Stream)

                Try
                    For m As Integer = 0 To 4
                        For n As Integer = 0 To 4
                            CX(m, n) = BinaryStreamReader.ReadByte
                        Next
                    Next
                Catch Ex As Exception
                    MessageBox.Show("Error reading " & PatnFileNameArray(count) & Ex.ToString)
                End Try
                BinaryStreamReader.Close()
                Stream.Close()
                Stream = Nothing
                BinaryStreamReader = Nothing
                ImgArray.Add(CreateBmp(CX).Clone)

            End If
        Next

    End Sub

    Private Sub LoadImages()
        Try
            If ImgArray Is Nothing Then
                Return
            End If

            If Me.WindowState = FormWindowState.Minimized Then
                Return
            End If
            Me.Cursor = Cursors.WaitCursor
            dataVImages.Rows.Clear()
            dataVImages.Columns.Clear()

            Dim ColumnsThatFit As Integer = (dataVImages.Width - 2) / (imgSize + 15)
            Dim numRows As Integer = 0

            Dim ImagesToDisplay As Integer = ImgArray.Count

            numRows = CInt(Math.Ceiling(CDbl(ImgArray.Count) / CDbl(ColumnsThatFit)))

            Dim CellsForPictureNumber As Integer = numRows * ColumnsThatFit

            ' Dynamically create the columns
            For index As Integer = 0 To ColumnsThatFit - 1
                Dim dataGridViewColumn As New DataGridViewImageColumn()

                dataVImages.Columns.Add(dataGridViewColumn)
                dataVImages.Columns(index).Width = imgSize + 15
            Next

            ' Create the rows

            For index As Integer = 0 To numRows - 1
                dataVImages.Rows.Add()
                dataVImages.Rows(index).Height = imgSize + 8
            Next

            Dim columnIndex As Integer = 0
            Dim rowIndex As Integer = 0

            For index As Integer = 0 To (ImagesToDisplay - 1)
                ' Load the image from the file and add to the DataGridView
                Dim img As Image = ResizeTheImage(ImgArray(index).clone, imgSize, imgSize, False)
                dataVImages.Rows(rowIndex).Cells(columnIndex).Value = img
                dataVImages.Rows(rowIndex).Cells(columnIndex).ToolTipText = PatnFileNameArray(index)

                ' Have we reached the end column? if so then start on the next row
                If columnIndex = ColumnsThatFit - 1 Then
                    rowIndex += 1
                    columnIndex = 0
                Else
                    columnIndex += 1
                End If
            Next
            ' Blank the unused cells
            If CellsForPictureNumber > ImagesToDisplay Then
                For index As Integer = 0 To CellsForPictureNumber - ImagesToDisplay - 1
                    Dim dataGridViewCellStyle As New DataGridViewCellStyle()
                    dataGridViewCellStyle.NullValue = Nothing
                    dataGridViewCellStyle.Tag = "BLANK"
                    dataVImages.Rows(rowIndex).Cells(columnIndex + index).Style = dataGridViewCellStyle
                Next
            End If
        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try
        Me.Cursor = Cursors.Default
    End Sub

The subroutine "FillImages" calls the function "CreateBmp" that will generate the bitmap from the 5x5 array of bytes read as boolean values(True or False) with this code:

               ImgArray.Add(CreateBmp(CX).Clone) ' Create Bitmap And Fill Array

    Private Function CreateBmp(ByRef Mx(,) As Boolean) As Image
        Dim Patn As New Bitmap(10, 10)
        For f As Integer = 0 To 4
            For g As Integer = 0 To 4
                If Mx(f, g) <> False Then
                    Patn.SetPixel(2 * g, 2 * f, Color.White)
                    Patn.SetPixel(2 * g + 1, 2 * f, Color.White)
                    Patn.SetPixel(2 * g, 2 * f + 1, Color.White)
                    Patn.SetPixel(2 * g + 1, 2 * f + 1, Color.White)
                Else
                    Patn.SetPixel(2 * g, 2 * f, Color.RosyBrown)
                    Patn.SetPixel(2 * g + 1, 2 * f, Color.RosyBrown)
                    Patn.SetPixel(2 * g, 2 * f + 1, Color.RosyBrown)
                    Patn.SetPixel(2 * g + 1, 2 * f + 1, Color.RosyBrown)

                End If
            Next
        Next
        Return Patn
    End Function

Every byte gives us a 2x2 pixel square on the generated bitmap. These images are to have a visual idea of the pattern, but are only used on the datagridview and the visual effect on the image created is most of the time created by ttwo adjacent patterns.

Now we are ready to process the image. If we press "Random Pattern" a new array is generated, on one of the red panels with black squares some squares will turn red. This is the pixelating pattern that will be applied to the image on the first picturebox and generate a new image for the second picturebox. This is a new pattern that can be saved to disk, can be rotated right or left or flipped horizontally. If you saved this pattern and did a rescan to the directory, it will appear on the datagridview.

    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 4
            For n As Integer = 0 To 4
                PX(m, n) = RandomValue(0, 100) 'For True Or False Values
            Next
        Next

        ' Display Position Colors On Panel. Twenty Five Of Them.

        AssignColor()
        MakePattern()
    End Sub

The Random Pattern Button (btnGenerate) fills the values of the array PX(m,n) and calls the routines "Assign Color" and "MakePattern" that will set the labels' color black or red:

    Private Sub AssignColor()
        If PX(0, 0) Then
            Label1.BackColor = Color.Black
        Else
            Label1.BackColor = Color.Red
        End If

        If PX(0, 1) Then
            Label2.BackColor = Color.Black
        Else
            Label2.BackColor = Color.Red
        End If

        If PX(0, 2) Then
            Label3.BackColor = Color.Black
        Else
            Label3.BackColor = Color.Red
        End If


        If PX(0, 3) Then
            Label4.BackColor = Color.Black
        Else
            Label4.BackColor = Color.Red
        End If


        If PX(0, 4) Then
            Label5.BackColor = Color.Black
        Else
            Label5.BackColor = Color.Red
        End If

        If PX(1, 0) Then
            Label6.BackColor = Color.Black
        Else
            Label6.BackColor = Color.Red
        End If

        If PX(1, 1) Then
            Label7.BackColor = Color.Black
        Else
            Label7.BackColor = Color.Red
        End If

        If PX(1, 2) Then
            Label8.BackColor = Color.Black
        Else
            Label8.BackColor = Color.Red
        End If

        If PX(1, 3) Then
            Label9.BackColor = Color.Black
        Else
            Label9.BackColor = Color.Red
        End If

        If PX(1, 4) Then
            Label10.BackColor = Color.Black
        Else
            Label10.BackColor = Color.Red
        End If

        If PX(2, 0) Then
            Label11.BackColor = Color.Black
        Else
            Label11.BackColor = Color.Red
        End If

        If PX(2, 1) Then
            Label12.BackColor = Color.Black
        Else
            Label12.BackColor = Color.Red
        End If

        If PX(2, 2) Then
            Label13.BackColor = Color.Black
        Else
            Label13.BackColor = Color.Red
        End If

        If PX(2, 3) Then
            Label14.BackColor = Color.Black
        Else
            Label14.BackColor = Color.Red
        End If

        If PX(2, 4) Then
            Label15.BackColor = Color.Black
        Else
            Label15.BackColor = Color.Red
        End If

        If PX(3, 0) Then
            Label16.BackColor = Color.Black
        Else
            Label16.BackColor = Color.Red
        End If

        If PX(3, 1) Then
            Label17.BackColor = Color.Black
        Else
            Label17.BackColor = Color.Red
        End If

        If PX(3, 2) Then
            Label18.BackColor = Color.Black
        Else
            Label18.BackColor = Color.Red
        End If

        If PX(3, 3) Then
            Label19.BackColor = Color.Black
        Else
            Label19.BackColor = Color.Red
        End If

        If PX(3, 4) Then
            Label20.BackColor = Color.Black
        Else
            Label20.BackColor = Color.Red
        End If

        If PX(4, 0) Then
            Label21.BackColor = Color.Black
        Else
            Label21.BackColor = Color.Red
        End If

        If PX(4, 1) Then
            Label22.BackColor = Color.Black
        Else
            Label22.BackColor = Color.Red
        End If

        If PX(4, 2) Then
            Label23.BackColor = Color.Black
        Else
            Label23.BackColor = Color.Red
        End If

        If PX(4, 3) Then
            Label24.BackColor = Color.Black
        Else
            Label24.BackColor = Color.Red
        End If

        If PX(4, 4) Then
            Label25.BackColor = Color.Black
        Else
            Label25.BackColor = Color.Red
        End If
    End Sub

And the subroutine "MakePattern" will process the image using lockbits on a two nested loops:

    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 = 5 'Size Of Pixelation
            Dim LastStrip As Integer ' If Image Height Is Not A Multiple Of 5

            'Loop Through The Values.

            For y = 0 To img.Height - stp - 1 Step stp
                If img.PixelFormat = PixelFormat.Format24bppRgb Then
                    For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - 3 Step 3 * stp '- 1 Step 3 * stp

                        ' Eliminate Intermediate Shades And Select Central Pixel

                        Dim ValR As Integer = 16 * (rgbvaluesSr(x + R + 6 + 2 * bmpSr.Stride) / 16)
                        Dim ValG As Integer = 16 * (rgbvaluesSr(x + G + 6 + 2 * bmpSr.Stride) / 16)
                        Dim ValB As Integer = 16 * (rgbvaluesSr(x + B + 6 + 2 * bmpSr.Stride) / 16)

                        ' Assign Colors

                        If PX(0, 0) Then
                            rgbvaluesSr(x + R) = ValR
                            rgbvaluesSr(x + G) = ValG
                            rgbvaluesSr(x + B)/> = ValB
                        Else
                            rgbvaluesSr(x + R) = 255 'ValR
                            rgbvaluesSr(x + G) = 255 'ValR
                            rgbvaluesSr(x + B)/> = 255 'ValR
                        End If


                        If PX(0, 1) Then
                            rgbvaluesSr(x + R + 3) = ValR
                            rgbvaluesSr(x + G + 3) = ValG
                            rgbvaluesSr(x + B + 3) = ValB
                        Else
                            rgbvaluesSr(x + R + 3) = 255
                            rgbvaluesSr(x + G + 3) = 255
                            rgbvaluesSr(x + B + 3) = 255
                        End If


                        If PX(0, 2) Then
                            rgbvaluesSr(x + R + 6) = ValR
                            rgbvaluesSr(x + G + 6) = ValG
                            rgbvaluesSr(x + B + 6) = ValB
                        Else
                            rgbvaluesSr(x + R + 6) = 255 'ValR
                            rgbvaluesSr(x + G + 6) = 255 'ValR
                            rgbvaluesSr(x + B + 6) = 255 'ValR
                        End If

                        If PX(0, 3) Then
                            rgbvaluesSr(x + R + 9) = ValR
                            rgbvaluesSr(x + G + 9) = ValG
                            rgbvaluesSr(x + B + 9) = ValB
                        Else
                            rgbvaluesSr(x + R + 9) = 255 'ValR
                            rgbvaluesSr(x + G + 9) = 255 'ValR
                            rgbvaluesSr(x + B + 9) = 255 'ValR
                        End If

                        If PX(0, 4) Then
                            rgbvaluesSr(x + R + 12) = ValR
                            rgbvaluesSr(x + G + 12) = ValG
                            rgbvaluesSr(x + B + 12) = ValB
                        Else
                            rgbvaluesSr(x + R + 12) = 255 'ValR
                            rgbvaluesSr(x + G + 12) = 255 'ValR
                            rgbvaluesSr(x + B + 12) = 255 'ValR
                        End If


                        If PX(1, 0) Then
                            rgbvaluesSr(x + R + bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(1, 1) Then
                            rgbvaluesSr(x + R + 3 + bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 3 + bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 3 + bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 3 + bmpSr.Stride) = 255
                            rgbvaluesSr(x + G + 3 + bmpSr.Stride) = 255
                            rgbvaluesSr(x + B + 3 + bmpSr.Stride) = 255
                        End If

                        If PX(1, 2) Then
                            rgbvaluesSr(x + R + 6 + bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 6 + bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 6 + bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 6 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 6 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 6 + bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(1, 3) Then
                            rgbvaluesSr(x + R + 9 + bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 9 + bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 9 + bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 9 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 9 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 9 + bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(1, 4) Then
                            rgbvaluesSr(x + R + 12 + bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 12 + bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 12 + bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 12 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 12 + bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 12 + bmpSr.Stride) = 255 'ValR
                        End If


                        If PX(2, 0) Then
                            rgbvaluesSr(x + R + 2 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 2 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 2 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 2 * bmpSr.Stride) = 255 'ValR
                        End If


                        If PX(2, 1) Then
                            rgbvaluesSr(x + R + 3 + 2 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 3 + 2 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 3 + 2 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 3 + 2 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + G + 3 + 2 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + B + 3 + 2 * bmpSr.Stride) = 255
                        End If


                        If PX(2, 2) Then
                            rgbvaluesSr(x + R + 6 + 2 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 6 + 2 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 6 + 2 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 6 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 6 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 6 + 2 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(2, 3) Then
                            rgbvaluesSr(x + R + 9 + 2 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 9 + 2 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 9 + 2 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 9 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 9 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 9 + 2 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(2, 4) Then
                            rgbvaluesSr(x + R + 12 + 2 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 12 + 2 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 12 + 2 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 12 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 12 + 2 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 12 + 2 * bmpSr.Stride) = 255 'ValR
                        End If



                        If PX(3, 0) Then
                            rgbvaluesSr(x + R + 3 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 3 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 3 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 3 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(3, 1) Then
                            rgbvaluesSr(x + R + 3 + 3 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 3 + 3 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 3 + 3 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 3 + 3 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + G + 3 + 3 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + B + 3 + 3 * bmpSr.Stride) = 255
                        End If

                        If PX(3, 2) Then
                            rgbvaluesSr(x + R + 6 + 3 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 6 + 3 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 6 + 3 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 6 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 6 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 6 + 3 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(3, 3) Then
                            rgbvaluesSr(x + R + 9 + 3 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 9 + 3 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 9 + 3 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 9 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 9 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 9 + 3 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(3, 4) Then
                            rgbvaluesSr(x + R + 12 + 3 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 12 + 3 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 12 + 3 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 12 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 12 + 3 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 12 + 3 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(4, 0) Then
                            rgbvaluesSr(x + R + 4 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 4 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 4 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 4 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(4, 1) Then
                            rgbvaluesSr(x + R + 3 + 4 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 3 + 4 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 3 + 4 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 3 + 4 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + G + 3 + 4 * bmpSr.Stride) = 255
                            rgbvaluesSr(x + B + 3 + 4 * bmpSr.Stride) = 255
                        End If

                        If PX(4, 2) Then
                            rgbvaluesSr(x + R + 6 + 4 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 6 + 4 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 6 + 4 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 6 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 6 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 6 + 4 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(4, 3) Then
                            rgbvaluesSr(x + R + 9 + 4 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 9 + 4 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 9 + 4 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 9 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 9 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 9 + 4 * bmpSr.Stride) = 255 'ValR
                        End If

                        If PX(4, 4) Then
                            rgbvaluesSr(x + R + 12 + 4 * bmpSr.Stride) = ValR
                            rgbvaluesSr(x + G + 12 + 4 * bmpSr.Stride) = ValG
                            rgbvaluesSr(x + B + 12 + 4 * bmpSr.Stride) = ValB
                        Else
                            rgbvaluesSr(x + R + 12 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + G + 12 + 4 * bmpSr.Stride) = 255 'ValR
                            rgbvaluesSr(x + B + 12 + 4 * bmpSr.Stride) = 255 'ValR
                        End If

                    Next x

                Else
                    MessageBox.Show("No Provisions Fot This Format")
                    Exit Sub
                End If
                LastStrip = y + stp
            Next y
            'Last Row
            For x = LastStrip * bmpSr.Stride - 1 To bytesSr - 3 Step 3
                rgbvaluesSr(x + R) = 255
                rgbvaluesSr(x + G) = 255
                rgbvaluesSr(x + B)/> = 255
            Next
            'Bottom Right corner
            rgbvaluesSr(bytesSr - 1) = 255
            rgbvaluesSr(bytesSr - 1) = 255
            rgbvaluesSr(bytesSr - 1) = 255


            System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptrSr, bytesSr)

            img.UnlockBits(bmpSr)
            Cross.Image = DoublSize(img, numSize.Value)
            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

This routine calls the function DoublSize that enlarges the resultimg image according to the value of the numeric up-down:

            Cross.Image = DoublSize(img, numSize.Value)

    Public Function DoublSize(ByVal OrigImg As Image, ByVal XSize As 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

If instead of pressing the "Random Pattern" button you click on one of the datagridview cells containing an image, that pattern will be used to pixelate the image.

    Private Sub dataVImages_CellClick(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dataVImages.CellClick
        'Select Frame By Using Mouse
        Dim i, j As Integer
        i = e.RowIndex
        j = e.ColumnIndex
        Position = i * dataVImages.Columns.Count + j ' + 1  'index of imagearray
        If Position > ImgArray.Count - 1 Then
            Exit Sub
        End If

        Dim Stream As FileStream
        Dim File_Name As String = "" 'PatN()

        Try
            Stream = New FileStream(PatnFileNameArray(Position), FileMode.Open)
        Catch Ex As Exception
            MessageBox.Show("Error opening " & PatnFileNameArray(Position) & Ex.ToString)
        End Try

        Dim BinaryStreamReader As New BinaryReader(Stream)

        Try
            For m As Integer = 0 To 4
                For n As Integer = 0 To 4
                    PX(m, n) = BinaryStreamReader.ReadByte
                Next
            Next
        Catch Ex As Exception
            MessageBox.Show("Error reading " & PatnFileNameArray(Position) & Ex.ToString)
        End Try
        BinaryStreamReader.Close()
        Stream.Close()
        Stream = Nothing
        BinaryStreamReader = Nothing

        If PX(0, 0) Then
            Label101.BackColor = Color.Black
        Else
            Label101.BackColor = Color.Red
        End If

        If PX(0, 1) Then
            Label102.BackColor = Color.Black
        Else
            Label102.BackColor = Color.Red
        End If

        If PX(0, 2) Then
            Label103.BackColor = Color.Black
        Else
            Label103.BackColor = Color.Red
        End If


        If PX(0, 3) Then
            Label104.BackColor = Color.Black
        Else
            Label104.BackColor = Color.Red
        End If


        If PX(0, 4) Then
            Label105.BackColor = Color.Black
        Else
            Label105.BackColor = Color.Red
        End If

        If PX(1, 0) Then
            Label106.BackColor = Color.Black
        Else
            Label106.BackColor = Color.Red
        End If

        If PX(1, 1) Then
            Label107.BackColor = Color.Black
        Else
            Label107.BackColor = Color.Red
        End If

        If PX(1, 2) Then
            Label108.BackColor = Color.Black
        Else
            Label108.BackColor = Color.Red
        End If

        If PX(1, 3) Then
            Label109.BackColor = Color.Black
        Else
            Label109.BackColor = Color.Red
        End If

        If PX(1, 4) Then
            Label110.BackColor = Color.Black
        Else
            Label110.BackColor = Color.Red
        End If

        If PX(2, 0) Then
            Label111.BackColor = Color.Black
        Else
            Label111.BackColor = Color.Red
        End If

        If PX(2, 1) Then
            Label112.BackColor = Color.Black
        Else
            Label112.BackColor = Color.Red
        End If

        If PX(2, 2) Then
            Label113.BackColor = Color.Black
        Else
            Label113.BackColor = Color.Red
        End If

        If PX(2, 3) Then
            Label114.BackColor = Color.Black
        Else
            Label114.BackColor = Color.Red
        End If

        If PX(2, 4) Then
            Label115.BackColor = Color.Black
        Else
            Label115.BackColor = Color.Red
        End If

        If PX(3, 0) Then
            Label116.BackColor = Color.Black
        Else
            Label116.BackColor = Color.Red
        End If

        If PX(3, 1) Then
            Label117.BackColor = Color.Black
        Else
            Label117.BackColor = Color.Red
        End If

        If PX(3, 2) Then
            Label118.BackColor = Color.Black
        Else
            Label118.BackColor = Color.Red
        End If

        If PX(3, 3) Then
            Label119.BackColor = Color.Black
        Else
            Label119.BackColor = Color.Red
        End If

        If PX(3, 4) Then
            Label120.BackColor = Color.Black
        Else
            Label120.BackColor = Color.Red
        End If

        If PX(4, 0) Then
            Label121.BackColor = Color.Black
        Else
            Label121.BackColor = Color.Red
        End If

        If PX(4, 1) Then
            Label122.BackColor = Color.Black
        Else
            Label122.BackColor = Color.Red
        End If

        If PX(4, 2) Then
            Label123.BackColor = Color.Black
        Else
            Label123.BackColor = Color.Red
        End If

        If PX(4, 3) Then
            Label124.BackColor = Color.Black
        Else
            Label124.BackColor = Color.Red
        End If

        If PX(4, 4) Then
            Label125.BackColor = Color.Black
        Else
            Label125.BackColor = Color.Red
        End If
        MakePattern()
    End Sub

The red panel is changed and the new image is created using this pattern by calling "MakePattern".

If you click on the checkbox "Manual" the red panel will be cleared and you could click an any of the black squares that will turn red, and will change the matrix containing the pattern. Then if you press "Manual OK" the new pattern will be applied.

This pattern can also be flipped or saved. If you change the magnification by means of the numeric up-down, you could process the image with the same pattern, but the result will be of different size.

    Private Sub btnLeft_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLeft.Click, btnRight.Click, btnFlip.Click
        Dim PXTemp(4, 4) As Boolean
        For Each Lab As Label In plCreatedPattern.Controls
            Lab.BackColor = Color.Black
        Next

        If sender Is btnLeft Then
            For f As Integer = 0 To 4
                For g As Integer = 0 To 4
                    PXTemp(f, g) = PX(g, 4 - f)
                Next
            Next
            For f = 0 To 4
                For g = 0 To 4
                    PX(f, g) = PXTemp(f, g)

                Next
            Next

        End If
        If sender Is btnRight Then
            For f As Integer = 0 To 4
                For g As Integer = 0 To 4
                    PXTemp(f, g) = PX(4 - g, f)
                Next
            Next
            For f = 0 To 4
                For g = 0 To 4
                    PX(f, g) = PXTemp(f, g)

                Next
            Next


        End If
        If sender Is btnFlip Then
            For f As Integer = 0 To 4
                For g As Integer = 0 To 4
                    PXTemp(f, g) = PX(f, 4 - g)
                Next
            Next
            For f As Integer = 0 To 4
                For g As Integer = 0 To 4
                    ' PX(f, g) = PXTemp(f, 4 - g)
                    PX(f, g) = PXTemp(f, g)
                Next
            Next
        End If
        AssignColor()
        MakePattern()
    End Sub

This will transform the array and flip the values for the pattern, and will generate a new image with the same pattern rotated or flipped.

Whatever pattern or array is been used at the moment can be saved as a pattern by clicking the diskette with the dots icon.

    Private Sub btnSavePattern_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSavePattern.Click, ToolStripMenuItem1.Click
        Binary()

    End Sub

    Private Sub Binary()

        Dim Stream As FileStream
        Dim FileName As String = PatN()
        Try
            Stream = New FileStream(FileName, FileMode.Create)
        Catch Ex As Exception
            MessageBox.Show("Error creating " & FileName & " " & Ex.ToString)
        End Try

        Dim BinaryStream As New BinaryWriter(Stream)

        Try
            For m As Integer = 0 To 4
                For n As Integer = 0 To 4
                    BinaryStream.Write(PX(m, n))
                Next
            Next

        Catch Ex As Exception
            MessageBox.Show("Error writing to " & FileName & " " & Ex.ToString)
            Stream.Close()
            BinaryStream.Close()
            Stream = Nothing
            BinaryStream = Nothing
        End Try

    End Sub
 

And the name generated here:

   Private Function PatN()
        Dim i As Integer
        Dim str As String = ""
        For i = 1 To 1000
            If i < 10 Then str = "Pat_00" & i.ToString & ".ptn"
            If i > 9 And i < 100 Then str = "Pat_0" & i.ToString & ".ptn"
            If i > 99 Then str = "Pat_" & i.ToString & ".ptn"
            If i > 900 Then MsgBox("You Have Over 900 Patterns," & vbNewLine & "Check What You Would Like To Keep")
            If Not System.IO.File.Exists(str) Then
                Return str
                Exit For
            End If
        Next

    End Function

When we click on the manual checkbox we will create our own pattern by clicking on the red panel. This will change the array and the square colors. Then We press "Manual OK" and the pattern will be used.

    Private Sub cbManual_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cbManual.CheckedChanged
        If cbManual.Checked = True Then
            For Each Lab As Label In plCreatedPattern.Controls
                Lab.BackColor = Color.Black
            Next
            For m As Integer = 0 To 4
                For n As Integer = 0 To 4
                    PX(m, n) = False
                Next
            Next
        End If
    End Sub

    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

        If cbManual.Checked = True Then
            ' Dim A, B As Single
            Dim Num, p, q As Integer
            'Avoid Problem Of Rounding Up
            Num = Val(sender.name.substring(5))
            ' A = Math.Floor((Num - 1) / 5)
            ' p = CInt(A)
            p = (Num - 1) \ 5
            ' B = Math.Floor((Num - 1) Mod 5)
            ' q = CInt(B)/>
            q = (Num - 1) Mod 5

            If sender.backcolor = Color.Black Then
                sender.backcolor = Color.Red
                PX(p, q) = True
            Else
                sender.backcolor = Color.Black
                PX(p, q) = False
            End If

        End If
    End Sub

    Private Sub btnManual_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnManual.Click
        MakePattern()
    End Sub

Here Are Some Accesory subroutines and functions.

The function that generates the random values only needs to produce a "TRUE" or "FALSE" value, but I generate a number on the 0 t0 100 range in order of having a more random value than 0-1, and them I convert it to true-false using a MOD function:

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

Some image formats won't create graphics objects, so I transform all of my images to RGB On OpenFlile:

    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

Save Image:

    Private Sub btnSaveImage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveImage.Click
        Dim i As Integer
        Dim str As String = ""
        For i = 1 To 1000
            If i < 10 Then str = "Picture_00" & i.ToString & ".jpg"
            If i > 9 And i < 100 Then str = "Picture_0" & i.ToString & ".jpg"
            If i > 99 Then str = "Picture_" & i.ToString & ".jpg"
            If i > 900 Then MsgBox("You Have Over 900 Pictures, Please Check And Delete Unnecesary Ones")
            If Not System.IO.File.Exists(str) Then
                Try
                    Cross.Image.Save(str, System.Drawing.Imaging.ImageFormat.Jpeg) 'Cropped
                Catch Ex As Exception
                    MsgBox("Could Not Write To Location")
                End Try
                Exit For
            End If
        Next

    End Sub


    Private Sub SaveToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SaveToolStripMenuItem.Click
        Dim i As Integer
        Dim str As String = ""
        For i = 1 To 1000
            If i < 10 Then str = "Picture_00" & i.ToString & ".jpg"
            If i > 9 And i < 100 Then str = "Picture_0" & i.ToString & ".jpg"
            If i > 99 Then str = "Picture_" & i.ToString & ".jpg"
            If i > 900 Then MsgBox("You Have Over 900 Pictures, Please Check And Delete Unnecesary Ones")
            If Not System.IO.File.Exists(str) Then
                Try
                    Cross.Image.Save(str, System.Drawing.Imaging.ImageFormat.Jpeg) 'Cropped
                Catch Ex As Exception
                    MsgBox("Could Not Write To Location")
                End Try
                Exit For
            End If
        Next

    End Sub

Exit and view folder:

    Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click
        Application.Exit()
    End Sub


    Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click
        Shell("Explorer " & AppDomain.CurrentDomain.BaseDirectory, AppWinStyle.NormalFocus)
    End Sub

Popup view of generated image when you hover on the black label with the anphibian eye:

    Private Sub lblPopup_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblPopup.MouseEnter
        'View Output Image Thumbnail
        pbFlash.Visible = True
        pbFlash.Image = Cross.Image
    End Sub

    Private Sub lblPopup_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblPopup.MouseLeave
        ' Hide PictureBox
        pbFlash.Visible = False
    End Sub

Image Resize:

    Private Function ResizeTheImage(ByVal Imgx As Image, ByVal width As Integer, ByVal height As Integer, ByVal onlyResizeIfWider As Boolean) As Image
        Using image1 As Image = Imgx
            ' Prevent using images internal thumbnail
            image1.RotateFlip(RotateFlipType.Rotate180FlipNone)
            image1.RotateFlip(RotateFlipType.Rotate180FlipNone)

            If onlyResizeIfWider = True Then
                If image1.Width <= width Then
                    width = image1.Width
                End If
            End If

            Dim newHeight As Integer = image1.Height * width / image1.Width
            If newHeight > height Then
                ' Resize with height instead
                width = image1.Width * height / image1.Height
                newHeight = height
            End If

            Dim NewImage As Image = image1.GetThumbnailImage(width, newHeight, Nothing, IntPtr.Zero)
            NewSize = 1
            Return NewImage
        End Using
    End Function

Scan for patterns:

    Private Sub ToolStripMenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem3.Click
        scan()
        FillImages()
        LoadImages()
    End Sub

This is about it.

Please look at the attached project and thank you for checking me out.

ricardosms.

Attached File(s)

•  RandomTexture.zip (493.04K)
  Number of downloads: 242

[ricardosms]

Hello.

One of the saved patterns is faulty. I believe it's #162. Check the size. it is zero instead of 25 bytes. I'm sorry. I missed it.
I am working on a 6x6 pattern generator if someone is interested. It gives more complex patterns and is coming good.
Regards,
ricardosms.

[ricardosms]

Hello everybody:

I am still working on the other version of the generator, but in the mean time I figured something out. I get much better image if instead of pixelating I just apply the texture. Also not to get the resulting image too faded because the white pixels I have an option to make them black. The new program will have adjacent pattern preview,other saving options, webcam image capture, and printing capabilities and because I am right handed I moved the controls to the right to be more accessible:





I will extort you now. Give me some reputation and I will post it!

Here is something for you to add or replace now if you like:

I have now two checkboxes 'cbPixelate' and 'cbBlack' and I replaced this code:

 
                       ' Assign Colors
                        For k As Integer = 0 To stp - 1
                            For l As Integer = 0 To stp - 1
                                If PX(k, l) Then
                                    rgbvaluesSr(x + R + 3 * l + k * bmpSr.Stride) = ValR
                                    rgbvaluesSr(x + G + 3 * l + k * bmpSr.Stride) = ValG
                                    rgbvaluesSr(x + B + 3 * l + k * bmpSr.Stride) = ValB
                                Else
                                    rgbvaluesSr(x + R + 3 * l + k * bmpSr.Stride) = 255
                                    rgbvaluesSr(x + G + 3 * l + k * bmpSr.Stride) = 255
                                    rgbvaluesSr(x + B + 3 * l + k * bmpSr.Stride) = 255
                                End If

                            Next
                        Next

 

Whith this one:

                       ' Assign Colors
                        For k As Integer = 0 To stp - 1
                            For l As Integer = 0 To stp - 1
                                If PX(k, l) Then
                                    If cbPixelate.Checked = True Then
                                        rgbvaluesSr(x + R + 3 * l + k * bmpSr.Stride) = ValR
                                        rgbvaluesSr(x + G + 3 * l + k * bmpSr.Stride) = ValG
                                        rgbvaluesSr(x + B + 3 * l + k * bmpSr.Stride) = ValB
                                    End If
                                Else
                                    If cbBlack.Checked = True Then
                                        rgbvaluesSr(x + R + 3 * l + k * bmpSr.Stride) = 0
                                        rgbvaluesSr(x + G + 3 * l + k * bmpSr.Stride) = 0
                                        rgbvaluesSr(x + B + 3 * l + k * bmpSr.Stride) = 0 
                                    Else
                                        rgbvaluesSr(x + R + 3 * l + k * bmpSr.Stride) = 255 
                                        rgbvaluesSr(x + G + 3 * l + k * bmpSr.Stride) = 255 
                                        rgbvaluesSr(x + B + 3 * l + k * bmpSr.Stride) = 255

                                    End If
                                End If

                            Next
        
                Next
[/code
]
I also have a routine to invert the pattern, colored pixels and white pixels with this code ina button.click handler:

[code]
            For f As Integer = 0 To 4
                For g As Integer = 0 To 4
                    If PX(f, g) = True Then
                        PX(f, g) = False
                    Else
                        PX(f, g) = True
                    End If
                Next
            Next

Thank you,
ricardosms.

[ricardosms]

OK, Everybody!
I am still waiting for comments, sugestions or bug reports, but nothing!

Anyway, you owe what you promise: this is version 2 of my "Random Texture Generator" program. It has few new gadgets and the code has changed a lot due to little improving on the loops, different size of pattern and use of lists instead of arraylists.

This one uses a 6x6 pixel pattern block, so it gives the possibility of generating 2^36 different patterns, I leave the math for you!

Although this pattern has the same file type than version 1, it is not compatible, so you will want to keep them separated. Been a 6x6 grid, symmetry is along lines and not around a central pixel, the block is a bit larger, so you get a larger pattern texture.

Due to the fact that not all images dimensions are on multiples of 6, some times you have a small strip on right and bottom, where the pattern is not applied, it requires a little bit more code with a control variable stopping the loop sooner. I leave that to you also.

The desktop has changed a bit and there are some more buttons for new routines.





Also the project has an extra windowsform for capturing images with a web camera.

To keep code for different sizes of patterns would force me to have too much repeated code, or too many more "if-else" branches that would make it very complicated and hard to follow. Besides the 6x6 gives better pattern(to my point of view). The visual effect is usually accomplished by adjacent blocks, so I have included a small preview window with 4 pictureboxes, so when yuou hover over a pattern you have an idea how it will look like.

The attached image gives you a view of the new controls. Also there are two routines to modify the images by clearing sections, one with color at image one, the other on white for image two.

You can see all the code in the new attached project. Also, there is a lot of tooltips popping around, there are just for training in case the program doesn't look intuitive enough, you may want to disable most of them.


The new form "CamCapture" allows you to use a web camera to obtain an image. It uses "avicap32.dll" and the code used is everywhere on the web. I have modified it a bit and added some rotating, resizing and cropping, before transferring it to the main form.

The pinting section also was copied from the internet and modified. It allows you to put your work on a paper.

I have also included some generated or created patterns for you to see and use.

Have fun!

ricardosms

Attached File(s)

•  RandomText.zip (282.22K)
  Number of downloads: 186