Page 1 of 1

LockBits-CrossStitch Pattern Creator-Color Reduction 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 04 February 2012 - 05:33 AM

LockBits-CrossStitch Pattern Creator-Color Reduction

Hello!

Today with the computerized embroidery sewing machines and with the built-in digitized patterns, not too many people do hand cross Stitch embroidery. It was popular when I was a child, back home. But still people buy and sew cross stitch patterns for blankets, table tops, children clothing, drapes, and some other crafts. And I know at of least one lady that does it regularly while listening to programs on television, peeking once on a while to the screen.

Anyway, the idea of making this program was just to make it. I do like these patterns, and as a child I did some small ones from educational magazines my mother had.

This program takes a picture and converts it to grid of squares and writting an 'X' on them using colors resembling the original image in a way that by observing it, it will recreate the original image in your mind.


Attached Image


There are few options or adjustments:

You can set the number of colors available to the pattern, you could lighten and darken the image, you could clear artifacts or undesired shadows or shades, clear certain colors, flip the original and enlarge the output or you can get an outline.

These resulting patterns are juts JPEG images that can be saved to disk. Another use that occurs to me is to create the screens for assigning colors to the leds on a pixel advertising board.

As allways, headings and the form load routine create the Tooltips and assign initial needed values and the drag and drop handlers, and we create the reload and work images:

Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D

Public Class Form1
    Dim W, H, NewWidth, NewHeight As Integer
    Dim Ratio As Single

    Dim minus As Color = Color.Black

    Dim Rx, Gx, Bx As Integer
    Dim RL, RH, GL, GH, BL, BH As Integer
    Dim WorkImg As Image
    Dim ReloadImg As Image
    Dim ToolTip1 As New ToolTip

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ToolTip1.AutoPopDelay = 1000
        ' ToolTip1.AutomaticDelay = 1000
        ToolTip1.InitialDelay = 1000
        ToolTip1.ReshowDelay = 2000
        ToolTip1.BackColor = Color.Aquamarine
        ToolTip1.SetToolTip(TrackBar1, "Dark<<Intensity>>Bright")
        ToolTip1.SetToolTip(sbEdge, "More<<Edge>>Less")
        ToolTip1.SetToolTip(btnPermanent, "Makes Image1 Permanent")
        ToolTip1.SetToolTip(btnSave1, "Saves Image1 To File")
        ToolTip1.SetToolTip(btnEdge, "Outlines Image1 According To Scroll Settings")
        ToolTip1.SetToolTip(btnSave2, "Saves Image2 To File")
        ToolTip1.SetToolTip(btnTransfer21, "Copy Image2 To PictureBox1")
        ToolTip1.SetToolTip(btnTransfer12, "Copy Image1 To PictureBox2")
        ToolTip1.SetToolTip(lblPopOrig, "Popup Original Image1 Thumbnail" & vbNewLine & "And Reload It To 

PictureBox1")
        ToolTip1.SetToolTip(lblPopPic1, "Popup Modified Image1 Thumbnail" & vbNewLine & "And Save It When Clicked")
        ToolTip1.SetToolTip(lblPopPic2, "Popup Image2 Thumbnail" & vbNewLine & "And Save It When Clicked")
        ToolTip1.SetToolTip(btnGenerate, "Convert To CrossStitch")
        ToolTip1.SetToolTip(rbTrueC, "Available Colors For Image")
        ToolTip1.SetToolTip(rbCol64, "Available Colors For Image")
        ToolTip1.SetToolTip(rbCol512, "Available Colors For Image")
        ToolTip1.SetToolTip(rbCol4096, "Available Colors For Image")
        ToolTip1.SetToolTip(Num1, "Magnification")
        ToolTip1.SetToolTip(btnConvert, "Reduce Colors")
        ToolTip1.SetToolTip(btnGenerate, "Create Pattern")
        ToolTip1.SetToolTip(btnClear, "Clear Selected Color")
        ToolTip1.SetToolTip(btnFlip, "Flip Image Horizontally")

        WorkImg = Work.Image
        ReloadImg = Work.Image.Clone
        W = Work.Width
        H = Work.Height
        Ratio = CSng(W / H)
        NewWidth = CInt(400 * Ratio)
        NewHeight = 400
        PopupPictures.Height = 400
        PopupPictures.Width = NewWidth


        'Drag And Drop

        AddHandler Me.DragDrop, AddressOf Form_DragDrop
        AddHandler Me.DragEnter, AddressOf Form_DragEnter

    End Sub
    Private Sub Form_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs)
        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
            ' Type of data
            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)))
                ReloadImg = ConvertToRGB(Image.FromFile(Files(0)))
                W = GetImageWidth(Files(0))
                H = GetImageHeight(Files(0))
                Ratio = CSng(W / H)
                NewWidth = CInt(400 * Ratio)
                NewHeight = 400
                PopupPictures.Height = 400
                PopupPictures.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)

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

    End Sub

    'Drag And Drop



OK! There, as I said, are few image manipulation routines: Horizontal Flip, Intensity Adjustment, Color Reduction, Convertion To RGB, Clearing Color, Getting Edges.

Horizontal Flip:


    Private Sub btnFlip_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFlip.Click
        Dim Bitmap1 As Bitmap
        Try
            Bitmap1 = CType(Work.Image, Bitmap)
            If Bitmap1 IsNot Nothing Then
                Bitmap1.RotateFlip(RotateFlipType.Rotate180FlipY)
                Work.Image = Bitmap1
            End If
        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try

    End Sub




Intensity Adjustment:
Here we use a trackbar to assign values to a color matrix and graphic objects to change the work image.

    Private Sub tbIntensity_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 

tbIntensity.MouseUp
        Dark()
    End Sub

    Private Sub Dark()
        Try
            Work.Image = WorkImg.Clone
            Dim image_attr As New ImageAttributes
            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 Wrk_img As New Bitmap(wid, hgt)
            Dim gr As Graphics = Graphics.FromImage(Work.Image)

            Dim cm As ColorMatrix = New ColorMatrix(New Single()() _
                { _
                New Single() {Math.Abs(tbIntensity.Value / 127), 0, 0, 0.0, 0.0}, _
                New Single() {0, Math.Abs(tbIntensity.Value / 127), 0, 0.0, 0.0}, _
                New Single() {0, 0, Math.Abs(tbIntensity.Value / 127), 0.0, 0.0}, _
                New Single() {0, 0, 0, 1.0, 0.0}, _
                New Single() {0.01, 0.01, 0.01, 0.0, 1.0}})

            image_attr.SetColorMatrix(cm)
            gr.DrawImage(Work.Image, rect, 0, 0, wid, hgt, GraphicsUnit.Pixel, image_attr)
            Work.Refresh()
        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try
    End Sub




We can then make these changes permanent by assigning the image to the work image by pressin "Glue 1".

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

btnPermanent.Click
        WorkImg = Work.Image
    End Sub




Color Reduction:

There are not millions of shades on commercial thread, so I tried to make some similar shades be grouped in an unique color, and at the same time getting the difference between areas a little more marked, so it would be easier to clear colors or getting outlines, so I divided the three color components on chunks of equal lenght and getting the individual values of each pixel transformed by susbtracting the values left afer a "MOD" operation and then multiplying them again by the original divider. This way I eliminate the small variation between chunks.

These values are selected by clicking on a radiobutton and by pressing the button "Set Colors". I have provided for truecolor, 4096, 512 and 64 colors. These colors are the maximum available to the embroidery pattern, but are not necessarily present:

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

btnConvert.Click
        Work.Image = ReduceColors(Work.Image)
    End Sub


   Private Function ReduceColors(ByVal img As Bitmap) As Image
        Dim R, G, B, Total, Reduction As Integer
        R = 2
        G = 1
        B = 0
        If rbCol64.Checked = True Then
            Reduction = 64
        ElseIf rbCol512.Checked = True Then
            Reduction = 32
        ElseIf rbCol4096.Checked = True Then
            Reduction = 16
        Else
            Reduction = 1
        End If
        '  Reduction = 32

        Try
            ' Lock the bitmap's bits.  
            Dim rect As New Rectangle(0, 0, img.Width, img.Height)
            Dim bmpData As System.Drawing.Imaging.BitmapData = img.LockBits(rect, _
                Drawing.Imaging.ImageLockMode.ReadWrite, img.PixelFormat)

            ' Get the address of the first line.
            Dim ptr As IntPtr = bmpData.Scan0

            ' Declare an array to hold the bytes of the bitmap.
            ' This code is specific to a bitmap with 24 bits per pixels.
            Dim bytes As Integer = Math.Abs(bmpData.Stride) * img.Height
            Dim rgbvaluesSr(bytes - 1) As Byte

            ' Copy the RGB values into the array.
            System.Runtime.InteropServices.Marshal.Copy(ptr, rgbvaluesSr, 0, bytes)


            For x As Integer = 0 To rgbvaluesSr.Length - 3 Step 3
                Total = CInt(rgbvaluesSr(x + R)) + CInt(rgbvaluesSr(x + G)) + CInt(rgbvaluesSr(x + B)/>)
                If Total < 765 Then
                    rgbvaluesSr(x + R) = rgbvaluesSr(x + R) - (rgbvaluesSr(x + R) Mod Reduction)
                    rgbvaluesSr(x + G) = rgbvaluesSr(x + G) - (rgbvaluesSr(x + G) Mod Reduction)
                    rgbvaluesSr(x + B)/> = rgbvaluesSr(x + B)/> - (rgbvaluesSr(x + B)/> Mod Reduction)
                End If
            Next

            ' Copy the RGB values back to the bitmap
            System.Runtime.InteropServices.Marshal.Copy(rgbvaluesSr, 0, ptr, bytes)

            ' Unlock the bits.
            img.UnlockBits(bmpData)

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





Convert To RGB:

Some images, like the ones with indexed color tables can not generate graphics objects to work on, so I transform them beforehand to RGB images by creating a RGB bitmap and painting on them the indexed image. It is a way of cheating, but who cares?

    Public Shared Function ConvertToRGB(ByVal original As Bitmap) As Bitmap
        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




Clearing a Color:

When you reduce the colors I have seen some problems, some shades became very dark, the clear background gets darkened, shadows are pronounced and some artifacts(spots) not seen on the original image appear. Also you may want to clear some colors to improve your pattern. So I have provide a function to clear a color by clicking and selecting it from the work image, comparing it with a range of colors selected from a scrollbar and processing the image to clear any similar enough color.

Clicking on the image picks a color and generates other values that are ranges of values for the color comparison.

    Private Sub Work_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 

Work.MouseClick
        Dim bmx As Bitmap
        bmx = New Bitmap(Work.Image)
        minus = bmx.GetPixel(e.X, e.Y)
        Rx = minus.R
        Gx = minus.G
        Bx = minus.B
        RL = Rx - 5
        If RL < 0 Then RL = 0
        GL = Gx - 5
        If GL < 0 Then GL = 0
        BL = Bx - 5
        If BL < 0 Then BL = 0

        RH = Rx + 5
        If RH > 255 Then RH = 255
        GH = Gx + 5
        If GH > 255 Then GH = 255
        BH = Bx + 5
        If BH > 255 Then BH = 255

    End Sub





    Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
        Dim x, y As Integer
        Dim Tol As Integer = sbTolerance.Value
        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 = Work.Image.Clone

            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, A As Integer
            A = 3
            R = 2
            G = 1
            B = 0
            Dim bytesSr As Integer = bmpSr.Stride * img.Height
            Dim rgbvaluesSr(bytesSr) As Byte
            System.Runtime.InteropServices.Marshal.Copy(ptrSr, rgbvaluesSr, 0, bytesSr)


            Dim RR, GG, BB As Integer
            Dim MinusR, MinusG, MinusB As Integer

            If img.PixelFormat = System.Drawing.Imaging.PixelFormat.Format24bppRgb Then
                For y = 0 To img.Height - 1

                    For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - 3 Step 3
                        RR = CInt(rgbvaluesSr(x + R))
                        GG = CInt(rgbvaluesSr(x + G))
                        BB = CInt(rgbvaluesSr(x + B)/>)
                        MinusR = CInt(minus.R)
                        MinusG = CInt(minus.G)
                        MinusB = CInt(minus.B)/>

                        If Math.Abs(RR - MinusR) < Tol And Math.Abs(GG - MinusG) < Tol And Math.Abs(BB - MinusB) < 

Tol Then

                            rgbvaluesSr(x + R) = 255
                            rgbvaluesSr(x + G) = 255
                            rgbvaluesSr(x + B)/> = 255

                        Else
                        End If
                    Next x

                Next y
            ElseIf img.PixelFormat = System.Drawing.Imaging.PixelFormat.Format32bppArgb Then
                For y = 0 To img.Height - 1
                    For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - 4 Step 4
                        RR = CInt(rgbvaluesSr(x + R))
                        GG = CInt(rgbvaluesSr(x + G))
                        BB = CInt(rgbvaluesSr(x + B)/>)
                        MinusR = CInt(minus.R)
                        MinusG = CInt(minus.G)
                        MinusB = CInt(minus.B)/>

                        If Math.Abs(RR - MinusR) < Tol And Math.Abs(GG - MinusG) < Tol And Math.Abs(BB - MinusB) < 

Tol Then

                            rgbvaluesSr(x + R) = 255
                            rgbvaluesSr(x + G) = 255
                            rgbvaluesSr(x + B)/> = 255
                            rgbvaluesSr(x + A) = 255
                        End If
                    Next x

                Next y

            Else
                MessageBox.Show("No Provisions for this format")
                img.UnlockBits(bmpSr)
                Exit Sub
            End If

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

            img.UnlockBits(bmpSr)
            Work.Image = img
            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("NoImage To Process")

        End Try

    End Sub



Getting Edges:

If you want the outline of the image, you could press "Edge". It will process the image to detect sharp variations of color or intensity and eliminate all the other flat colors, the amount of variation on the value of the neighboring pixels is set by a scrollbar:

    Private Sub btnEdge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEdge.Click
        Dim x, y As Integer
        Dim Tol As Integer = sbEdge.Value '10 'TrackBar5.Value

        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
            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, A, A1, A2, A3, A4 As Integer
            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)
            'For i As Integer = 0 To rgbvaluesSr.Length - 4 Step 4
            For y = 0 To img.Height - 2
                If img.PixelFormat = PixelFormat.Format24bppRgb Then
                    For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - 6 Step 3
                        A1 = CInt(rgbvaluesSr(x + R)) + CInt(rgbvaluesSr(x + G)) + CInt(rgbvaluesSr(x + B)/>)
                        A2 = CInt(rgbvaluesSr(x + 4 + R)) + CInt(rgbvaluesSr(x + 4 + G)) + CInt(rgbvaluesSr(x + 4 + 

B)/>)
                        A3 = CInt(rgbvaluesSr(x + R + bmpSr.Stride)) + CInt(rgbvaluesSr(x + G + bmpSr.Stride)) + 

CInt(rgbvaluesSr(x + B + bmpSr.Stride))
                        A4 = CInt(rgbvaluesSr(x + 4 + R + bmpSr.Stride)) + CInt(rgbvaluesSr(x + 4 + G + 

bmpSr.Stride)) + CInt(rgbvaluesSr(x + 4 + B + bmpSr.Stride))

                        'If (A2 - A1) > Tol Or (A3 - A1) > Tol Or (A4 - A1) > Tol Then
                        If Math.Abs(A2 - A1) > Tol Or Math.Abs(A3 - A1) > Tol Or Math.Abs(A4 - A1) > Tol Then

                            '   rgbvaluesSr(x + R) = 0
                            '  rgbvaluesSr(x + G) = 0
                            '  rgbvaluesSr(x + B)/> = 0


                        Else
                            rgbvaluesSr(x + R) = 255
                            rgbvaluesSr(x + G) = 255
                            rgbvaluesSr(x + B)/> = 255

                        End If
                        If x = (y + 1) * bmpSr.Stride - 3 Then
                            'Dark Line To the Right
                            rgbvaluesSr(x + R + 4) = 255
                            rgbvaluesSr(x + G + 4) = 255
                            rgbvaluesSr(x + B + 4) = 255
                            rgbvaluesSr(x + R + 8) = 255
                            rgbvaluesSr(x + G + 8) = 255
                            rgbvaluesSr(x + B + 8) = 255
                            rgbvaluesSr(x + R + 12) = 255
                            rgbvaluesSr(x + G + 12) = 255
                            rgbvaluesSr(x + B + 12) = 255

                        End If
                    Next x

                ElseIf img.PixelFormat = PixelFormat.Format32bppArgb Then
                    For x = y * bmpSr.Stride To (y + 1) * bmpSr.Stride - 8 Step 4
                        A1 = CInt(rgbvaluesSr(x + R)) + CInt(rgbvaluesSr(x + G)) + CInt(rgbvaluesSr(x + B)/>)
                        A2 = CInt(rgbvaluesSr(x + 4 + R)) + CInt(rgbvaluesSr(x + 4 + G)) + CInt(rgbvaluesSr(x + 4 + 

B)/>)
                        A3 = CInt(rgbvaluesSr(x + R + bmpSr.Stride)) + CInt(rgbvaluesSr(x + G + bmpSr.Stride)) + 

CInt(rgbvaluesSr(x + B + bmpSr.Stride))
                        A4 = CInt(rgbvaluesSr(x + 4 + R + bmpSr.Stride)) + CInt(rgbvaluesSr(x + 4 + G + 

bmpSr.Stride)) + CInt(rgbvaluesSr(x + 4 + B + bmpSr.Stride))

                        'If (A2 - A1) > Tol Or (A3 - A1) > Tol Or (A4 - A1) > Tol Then
                        If Math.Abs(A2 - A1) > Tol Or Math.Abs(A3 - A1) > Tol Or Math.Abs(A4 - A1) > Tol Then

                            ' rgbvaluesSr(x + A) = 255
                            ' rgbvaluesSr(x + R) = 0
                            ' rgbvaluesSr(x + G) = 0
                            ' rgbvaluesSr(x + B)/> = 0


                        Else
                            rgbvaluesSr(x + A) = 255
                            rgbvaluesSr(x + R) = 255
                            rgbvaluesSr(x + G) = 255
                            rgbvaluesSr(x + B)/> = 255

                        End If
                        If x = (y + 1) * bmpSr.Stride - 8 Then
                            'Dark Line To the Right
                            rgbvaluesSr(x + A + 4) = 255
                            rgbvaluesSr(x + R + 4) = 255
                            rgbvaluesSr(x + G + 4) = 255
                            rgbvaluesSr(x + B + 4) = 255
                            rgbvaluesSr(x + A + 8) = 255
                            rgbvaluesSr(x + R + 8) = 255
                            rgbvaluesSr(x + G + 8) = 255
                            rgbvaluesSr(x + B + 8) = 255
                            rgbvaluesSr(x + A + 12) = 255
                            rgbvaluesSr(x + R + 12) = 255
                            rgbvaluesSr(x + G + 12) = 255
                            rgbvaluesSr(x + B + 12) = 255

                        End If
                    Next x
                Else
                    MessageBox.Show("No Provisions Fot This Format")
                    Exit Sub
                End If


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

            img.UnlockBits(bmpSr)
            Work.Image = img
            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
            MessageBox.Show("NoImage To Process")
        End Try

    End Sub




The pattern creation routine runs on two nested loops using lockbits, so we move across and down on the values of "x" and "y". We divide the image in squares of 5 pixels, that is a small area of about one-sixteen of and inch. It is an odd number so we can have a simmetric "X". We check the values of the colors in that area and determine the color of the "X" and assign that value to the figure and blank all the other pixels.

When we are done and return the image, we enlarge it by a factor set on the numeric Up-Down. We are enlarging a picture that may already be large, so there is a warning when the value is set to 5:

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

Num1.ValueChanged
        If Num1.Value = 5 Then MessageBox.Show("Please Be Cautious With Large Images")
    End Sub




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

btnGenerate.Click
        Dim x, y As Integer
        WorkImg = Work.Image
        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 'ConvertToLess(WorkImg.Clone)
            img = ConvertToRGB(img)
            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
            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


            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 Step 3 * stp


                        '  Dim PromR As Integer = rgbvaluesSr(x + R + 6 + 2 * bmpSr.Stride)
                        '  Dim PromG As Integer = rgbvaluesSr(x + G + 6 + 2 * bmpSr.Stride)
                        '  Dim PromB As Integer = rgbvaluesSr(x + B + 6 + 2 * bmpSr.Stride)
                        Dim PromR As Integer = 16 * (rgbvaluesSr(x + R + 6 + 2 * bmpSr.Stride) / 16)
                        Dim PromG As Integer = 16 * (rgbvaluesSr(x + G + 6 + 2 * bmpSr.Stride) / 16)
                        Dim PromB As Integer = 16 * (rgbvaluesSr(x + B + 6 + 2 * bmpSr.Stride) / 16)

                        rgbvaluesSr(x + R) = 255 'PromR
                        rgbvaluesSr(x + R + 12) = 255 'PromR
                        rgbvaluesSr(x + G) = 255 'PromG
                        rgbvaluesSr(x + G + 12) = 255 'PromG
                        rgbvaluesSr(x + B)/> = 255 'PromB
                        rgbvaluesSr(x + B + 12) = 255 'PromB
                        rgbvaluesSr(x + R + 3) = 255
                        rgbvaluesSr(x + R + 9) = 255
                        rgbvaluesSr(x + G + 3) = 255
                        rgbvaluesSr(x + G + 9) = 255
                        rgbvaluesSr(x + B + 3) = 255
                        rgbvaluesSr(x + B + 9) = 255
                        rgbvaluesSr(x + R + 6) = 255
                        rgbvaluesSr(x + G + 6) = 255
                        rgbvaluesSr(x + B + 6) = 255
                        '
                        rgbvaluesSr(x + R + bmpSr.Stride + 3) = PromR
                        rgbvaluesSr(x + R + bmpSr.Stride + 9) = PromR
                        rgbvaluesSr(x + G + bmpSr.Stride + 3) = PromG
                        rgbvaluesSr(x + G + bmpSr.Stride + 9) = PromG
                        rgbvaluesSr(x + B + bmpSr.Stride + 3) = PromB
                        rgbvaluesSr(x + B + bmpSr.Stride + 9) = PromB
                        rgbvaluesSr(x + R + bmpSr.Stride) = 255
                        rgbvaluesSr(x + R + bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + G + bmpSr.Stride) = 255
                        rgbvaluesSr(x + G + bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + B + bmpSr.Stride) = 255
                        rgbvaluesSr(x + B + bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + R + bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + G + bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + B + bmpSr.Stride + 6) = 255
                        '
                        rgbvaluesSr(x + R + 2 * bmpSr.Stride + 6) = PromR
                        rgbvaluesSr(x + G + 2 * bmpSr.Stride + 6) = PromG
                        rgbvaluesSr(x + B + 2 * bmpSr.Stride + 6) = PromB
                        rgbvaluesSr(x + R + 2 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + R + 2 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + G + 2 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + G + 2 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + B + 2 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + B + 2 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + R + 2 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + R + 2 * bmpSr.Stride + 9) = 255
                        rgbvaluesSr(x + G + 2 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + G + 2 * bmpSr.Stride + 9) = 255
                        rgbvaluesSr(x + B + 2 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + B + 2 * bmpSr.Stride + 9) = 255

                        '
                        rgbvaluesSr(x + R + 3 * bmpSr.Stride + 3) = PromR
                        rgbvaluesSr(x + R + 3 * bmpSr.Stride + 9) = PromR
                        rgbvaluesSr(x + G + 3 * bmpSr.Stride + 3) = PromG
                        rgbvaluesSr(x + G + 3 * bmpSr.Stride + 9) = PromG
                        rgbvaluesSr(x + B + 3 * bmpSr.Stride + 3) = PromB
                        rgbvaluesSr(x + B + 3 * bmpSr.Stride + 9) = PromB
                        rgbvaluesSr(x + R + 3 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + R + 3 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + G + 3 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + G + 3 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + B + 3 * bmpSr.Stride) = 255
                        rgbvaluesSr(x + B + 3 * bmpSr.Stride + 12) = 255
                        rgbvaluesSr(x + R + 3 * bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + G + 3 * bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + B + 3 * bmpSr.Stride + 6) = 255
                        '
                        rgbvaluesSr(x + R + 4 * bmpSr.Stride) = 255 ' PromR
                        rgbvaluesSr(x + R + 4 * bmpSr.Stride + 12) = 255 'PromR
                        rgbvaluesSr(x + G + 4 * bmpSr.Stride) = 255 'PromG
                        rgbvaluesSr(x + G + 4 * bmpSr.Stride + 12) = 255 'PromG
                        rgbvaluesSr(x + B + 4 * bmpSr.Stride) = 255 'PromB
                        rgbvaluesSr(x + B + 4 * bmpSr.Stride + 12) = 255 'PromB
                        rgbvaluesSr(x + R + 4 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + R + 4 * bmpSr.Stride + 9) = 255
                        rgbvaluesSr(x + G + 4 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + G + 4 * bmpSr.Stride + 9) = 255
                        rgbvaluesSr(x + B + 4 * bmpSr.Stride + 3) = 255
                        rgbvaluesSr(x + B + 4 * bmpSr.Stride + 9) = 255
                        rgbvaluesSr(x + R + 4 * bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + G + 4 * bmpSr.Stride + 6) = 255
                        rgbvaluesSr(x + B + 4 * bmpSr.Stride + 6) = 255
                        '


                        If x = (y + 1) * bmpSr.Stride - 6 Then
                            'Dark Line To the Right
                            rgbvaluesSr(x + R + 4) = 255
                            rgbvaluesSr(x + G + 4) = 255
                            rgbvaluesSr(x + B + 4) = 255
                            rgbvaluesSr(x + R + 8) = 255
                            rgbvaluesSr(x + G + 8) = 255
                            rgbvaluesSr(x + B + 8) = 255
                            rgbvaluesSr(x + R + 12) = 255
                            rgbvaluesSr(x + G + 12) = 255
                            rgbvaluesSr(x + B + 12) = 255

                        End If
                    Next x

                Else
                    MessageBox.Show("No Provisions Fot This Format")
                    Exit Sub
                End If

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

            img.UnlockBits(bmpSr)
            '          PictureBox1.Image = img
            '           PictureBox1.Invalidate()
            Cross.Image = DoublSize(img, Num1.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




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





I play with graphics, but as you may already have noticed, I am not good for graphic design, I don't produce good user's interfaces, but I go more to functionality on my end. Anyway, you may have noticed an enclosed area with three black squares, two arrows and two diskette icons. These are convenience commands.

The arrows will tranfer the image on the left picturebox to the right one and vice-versa. The diskette icons, will save the image 1 or the image 2.

The 3 squares are black labels (like some whiskeys), the left one will pop a thumbail of the reload image when hovering on it. If you click on it you will reload the original image to picturebox1. The one in the center pops up a thumbnail of the inmediate work image, appearing on picturebox1. Some images are larger than the panel, so they won't show on its entirety. If you click on it, it will save the thumbnail on its actual size. The one on the right will do the same but with the cross stitch pattern image:


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

lblPopPic1.MouseEnter, lblPopPic2.MouseEnter, lblPopOrig.MouseEnter
        If sender Is lblPopPic1 Then PopupPictures.Image = Work.Image
        If sender Is lblPopPic2 Then PopupPictures.Image = Cross.Image
        If sender Is lblPopOrig Then PopupPictures.Image = ReloadImg
        PopupPictures.Visible = True

    End Sub

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

lblPopPic1.MouseLeave, lblPopPic2.MouseLeave, lblPopOrig.MouseLeave
        PopupPictures.Visible = False
    End Sub





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

btnTransfer21.Click
        Work.Image = Cross.Image.Clone
    End Sub

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

btnTransfer12.Click
        Cross.Image = Work.Image.Clone
    End Sub

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

lblPopPic1.Click, lblPopPic2.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
                    If Not PopupPictures.Image Is Nothing Then
                        ' Image Size Is Not The Same As PictureBox Size(SizeMode)
                        GetThumb(PopupPictures.Image, PopupPictures.Width, PopupPictures.Height).Save(str, 

System.Drawing.Imaging.ImageFormat.Jpeg)
                    End If
                Catch Ex As Exception
                    MsgBox("Could Not Write To Location")
                End Try
                Exit For
            End If
        Next

    End Sub
    Public Function GetThumb(ByVal OrigImg As Image, ByVal NewW As Integer, ByVal NewH As Integer) As Image
        Dim imgFormat = OrigImg.RawFormat


        'Create Bitmap from the image
        Dim imgOutput As New Bitmap(OrigImg, NewW, NewH)

        '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, PopupPictures.Width, PopupPictures.Height)

        GResize.Dispose()

        Return imgOutput

    End Function




Using the arrows you can transfer back and forth images between picturebox1 and picturebox2. I have provided a routine for picturebox2 that will clear and area by clicking and dragging the mouse. At mouseup it will clear that area, then you could transfer it to picturebox1 in order to more processing. There we are creating a polygon and filling it with white:

    Private Sub Cross_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 

Cross.MouseDown
        selected_path.Reset()
        ' Erase any previous drawing.
        ' Save the starting point.
        m_MaxPoint = 0
        ReDim m_Points(m_MaxPoint)
        m_Points(m_MaxPoint).X = e.X
        m_Points(m_MaxPoint).Y = e.Y
    End Sub

    Private Sub Cross_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 

Cross.MouseMove
        If (e.Button = MouseButtons.Left) Then
            ' Do nothing if we're not selecting a region.
            If m_Points Is Nothing Then Exit Sub

            ' Save the new point.
            m_MaxPoint += 1
            ReDim Preserve m_Points(m_MaxPoint)
            m_Points(m_MaxPoint).X = e.X
            m_Points(m_MaxPoint).Y = e.Y

            ' Draw the latest line.
            Dim gr As Graphics = Cross.CreateGraphics
            'gr.DrawLine(Pens.Yellow, _
            gr.DrawLine(Pens.White, _
                m_Points(m_MaxPoint).X, _
                m_Points(m_MaxPoint).Y, _
                m_Points(m_MaxPoint - 1).X, _
                m_Points(m_MaxPoint - 1).Y)
        End If
    End Sub

    Private Sub Cross_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles 

Cross.MouseUp
        Dim MyGraphics As Graphics
        Dim TransBrush As New SolidBrush(Color.White)
        ' Do nothing if we're not selecting a region.
        If m_Points Is Nothing Then Exit Sub

        ' Close the region.
        If (m_Points(0).X <> m_Points(m_MaxPoint).X) Or _
           (m_Points(0).Y <> m_Points(m_MaxPoint).Y) _
        Then
            ' Save the new point.
            m_MaxPoint += 1
            ReDim Preserve m_Points(m_MaxPoint)
            m_Points(m_MaxPoint).X = m_Points(0).X
            m_Points(m_MaxPoint).Y = m_Points(0).Y
        End If

        ' Make the points into a Path.
        selected_path.AddLines(m_Points)

        Try
            ' px(UBound(pts)) = px(0)
            Dim bm As New Bitmap(Cross.Image)
            MyGraphics = Graphics.FromImage(bm)
            MyGraphics.FillPolygon(TransBrush, m_Points)
            Cross.Image = bm
            m_Points = Nothing
            GC.Collect()
        Catch
            MessageBox.Show("Error")
            m_Points = Nothing

            Exit Sub

        End Try

    End Sub



There is a little bit more of code that you could see in the project enclosed, that is just convenience routines, like view output folder ore check pixel format.

Take a look, please.

Thank you for checking me out.

ricardosms.

Attached File(s)



Is This A Good Question/Topic? 0
  • +

Page 1 of 1