|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 |
Public Class Form1 Dim Cycles As Integer = 0 Dim DictionaryListUsed As New Dictionary(Of Color, Integer) Dim DictionaryList As New Dictionary(Of Color, Integer) Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim img As Bitmap = New Bitmap("C:\Users\User\Desktop\GoogleMap.png") Dim x, y As Integer Using G As Graphics = Me.CreateGraphics Dim BMP As New Bitmap(img.Width, img.Height) Dim BMP2 As New Bitmap(img.Width, img.Height) Dim pixel As Color = Nothing For x = 0 To img.Width - 1 For y = 0 To img.Height - 1 pixel = img.GetPixel(x, y) If (DictionaryList.ContainsKey(pixel)) Then DictionaryList(pixel) += 1 Else DictionaryList.Add(pixel, 1) End If If pixel.R >= 252 And pixel.G = pixel.R And pixel.B = pixel.R Then 'WhiteWhite BMP2.SetPixel(x, y, Color.Red) 'Continue For End If If pixel.R = 237 And pixel.G = 235 And pixel.B = 232 Then 'Grayer 'Continue For End If If pixel.R > 215 And pixel.R < 250 And ((pixel.G = pixel.R) Or ((pixel.G <= (pixel.R + 6)) And (pixel.G >= (pixel.R - 6)))) And ((pixel.B = pixel.R) Or ((pixel.B <= (pixel.R + 6)) And (pixel.B >= (pixel.R - 6)))) Then 'Some shade of Gray Continue For End If If (DictionaryListUsed.ContainsKey(pixel)) Then DictionaryListUsed(pixel) += 1 Else DictionaryListUsed.Add(pixel, 1) End If BMP.SetPixel(x, y, pixel) Cycles += 1 'Debug.WriteLine(x & "," & y & " - " & pixel.ToString) Next Next Debug.WriteLine(Cycles) 'G.DrawImage(BMP, New Point(10, 10)) PictureBox1.Image = BMP 'G.DrawImage(BMP2, New Point(10, 10)) PictureBox2.Image = BMP2 End Using Dim sorted = From pair In DictionaryListUsed Order By pair.Value Descending Dim sortedDictionary = sorted.ToDictionary(Function(p) p.Key, Function(p) p.Value) Dim sorted2 = From pair In DictionaryList Order By pair.Value Descending Dim sortedDictionary2 = sorted2.ToDictionary(Function(p) p.Key, Function(p) p.Value) 'PictureBox1.BackColor = sortedDictionary2.First().Key 'End RepairRoad() End Sub Private Sub RepairRoad() Dim MyColor As Color = Color.FromArgb(255, 254, 0, 0) Dim img As Bitmap = PictureBox2.Image Dim pixel As Color = Nothing Dim Count As Integer = 0 For x = 0 To img.Width - 1 For y = 0 To img.Height - 1 pixel = img.GetPixel(x, y) If pixel.R = 255 And pixel.G = 0 And pixel.B = 0 Then Count = CheckSurroundingPixelForColor(img, New Point(x, y), Color.Red) If Count > 3 Then SetSurroundingPixelToColor(img, New Point(x, y), MyColor) Else Debug.WriteLine(Count) End If 'Debug.WriteLine(pixel) 'System.Diagnostics.Debugger.Break() End If Next Next End Sub Private Function CheckSurroundingPixelForColor(ByVal MyBitmap As Bitmap, ByVal mypoint As Point, ByVal MyColor As Color) As Integer 'Returns number of surrounding pixels Dim Count As Integer = 0 If mypoint.X > 0 Then If MyBitmap.GetPixel(mypoint.X - 1, mypoint.Y).ToArgb = MyColor.ToArgb Then Count += 1 If mypoint.Y > 0 Then If MyBitmap.GetPixel(mypoint.X - 1, mypoint.Y - 1).ToArgb = MyColor.ToArgb Then Count += 1 End If If mypoint.Y < MyBitmap.Height - 1 Then If MyBitmap.GetPixel(mypoint.X - 1, mypoint.Y + 1).ToArgb = MyColor.ToArgb Then Count += 1 End If End If If mypoint.Y > 0 Then If MyBitmap.GetPixel(mypoint.X, mypoint.Y - 1).ToArgb = MyColor.ToArgb Then Count += 1 If mypoint.X < MyBitmap.Width - 1 Then If MyBitmap.GetPixel(mypoint.X + 1, mypoint.Y - 1).ToArgb = MyColor.ToArgb Then Count += 1 End If End If If mypoint.Y < MyBitmap.Height - 1 Then If MyBitmap.GetPixel(mypoint.X, mypoint.Y + 1).ToArgb = MyColor.ToArgb Then Count += 1 End If If mypoint.X < MyBitmap.Width - 1 Then If MyBitmap.GetPixel(mypoint.X + 1, mypoint.Y + 1).ToArgb = MyColor.ToArgb Then Count += 1 End If End If If mypoint.X < MyBitmap.Width - 1 Then If MyBitmap.GetPixel(mypoint.X + 1, mypoint.Y).ToArgb = MyColor.ToArgb Then Count += 1 End If Return Count End Function Private Function SetSurroundingPixelToColor(ByVal MyBitmap As Bitmap, ByVal mypoint As Point, ByVal MyColor As Color) As Integer 'Returns number of surrounding pixels On Error Resume Next MyBitmap.SetPixel(mypoint.X - 1, mypoint.Y - 1, MyColor) MyBitmap.SetPixel(mypoint.X - 1, mypoint.Y, MyColor) MyBitmap.SetPixel(mypoint.X - 1, mypoint.Y + 1, MyColor) MyBitmap.SetPixel(mypoint.X, mypoint.Y - 1, MyColor) MyBitmap.SetPixel(mypoint.X, mypoint.Y + 1, MyColor) MyBitmap.SetPixel(mypoint.X + 1, mypoint.Y - 1, MyColor) MyBitmap.SetPixel(mypoint.X + 1, mypoint.Y, MyColor) MyBitmap.SetPixel(mypoint.X + 1, mypoint.Y + 1, MyColor) End Function Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown Dim bmp As Bitmap = New Bitmap(PictureBox1.Image) Dim colour As Color = bmp.GetPixel(e.X, e.Y) Label1.Text = colour.ToString() bmp.Dispose() End Sub End Class |