| Вопрос: Выделение контуров | Добавлено: 27.08.09 00:31 |
Автор вопроса:  portC | Web-сайт: feshin.info
|
|
Как в виде кода реализовать выделение контуров (есть белая картинка с черными фигурами), необходимо быстро выделить контуры
Пытаюсь реализовать: сканируем матрицу пикселов пока не встречаем черный (но сами остаемся на белом). Дальше начинаем обход '1. Запоминаем свои координаты. '2. Если можно двигаться в текущем направлении, то перемещаемся на один пиксель (двигаемся только по белым точкам) 'и поворачиваемся (на месте, просто изменяем направление) по часовой стрелке на 90 градусов. 'А в противном случае (если двигаться не можем) то поворачиваемся на 90 градусов против часовой стрелки. '3. После каждого перемещения, проверяем не вернулись ли мы в исходную точку. Если нет, то переходим к пункту 2, иначе конец. Но не работает ничего :'-((( помощь оч нужна |
| Ответы | Всего ответов: 19 |
|
Номер ответа: 1 Автор ответа:  portC Вопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #1 | Добавлено: 27.08.09 00:42 |
| да, черных фигур на картинке несколько | ||
|
Номер ответа: 2 Автор ответа: UnDeAdZakВопросов: 80 Ответов: 476 |
Профиль | | #2 | Добавлено: 27.08.09 00:46 |
| а если сделать на картинке все цвета невидимыми, кроме чёрного? | ||
|
Номер ответа: 3 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #3 | Добавлено: 27.08.09 00:55 |
Public Sub find_object()
 im x As Integer
im y As Integer
im steppx As Integer
im steppy As Integer
im xmax As Integer
im ymax As Integer
im ar, ag, ab, br, bg, bb As Integer
im a, b As Long
im sense As Integer
' Dim sch1 As Integer im sdvig As Integer
' Dim sravni As Variant ' Dim sravni2 As Variant im x1 As Integer
im y1 As Integer
im polovina As Integer
Timer1.Enabled = False 'sch1 = 0 sdvig = 1 steppx = steppy = 2 'Slider5.Value xmax = $device.Width - 1 ymax = $device.Height - 1 DrawingArea1.Width = $device.Width DrawingArea1.Height = $device.Height $device.Save("im2.jpg" 
im2 = Image.Load("im2.jpg"
sense = 255 - Slider3.Value * 5 polovina = ($device.Height) / 2 x = 0 y = 0 ar = (((im2[x, y])) Mod 256) 'dev br = ((im[x, y]) Mod 256) 'im ag = (((im2[x, y]) \ 256) Mod 256) bg = (((im[x, y]) \ 256) Mod 256) ab = ((((im2[x, y]) \ 256) \ 256) Mod 256) bb = ((((im[x, y]) \ 256) \ 256) Mod 256) Do ' For x = 0 To xmax Step steppx For y = 0 To ymax Step steppy 'Do x = x + steppx ar = (((im2[x, y])) Mod 256) 'dev br = ((im[x, y]) Mod 256) 'im ag = (((im2[x, y]) \ 256) Mod 256) bg = (((im[x, y]) \ 256) Mod 256) ab = ((((im2[x, y]) \ 256) \ 256) Mod 256) bb = ((((im[x, y]) \ 256) \ 256) Mod 256) If Sqr((ar - br) * (ar - br) + (ag - bg) * (ag - bg) + (ab - bb) * (ab - bb)) > sense Then 'типа черная точка нашлась x1 = x y1 = y raw.Begin(DrawingArea1)
raw.ForeColor = &HFFFFFF
draw.FillStyle = 1 raw.Point(x1, y1)
raw.End
'sravni = Sqr((ar - br) * (ar - br) + (ag - bg) * (ag - bg) + (ab - bb) * (ab - bb)) End If Next ' Next Loop Until Sqr((ar - br) * (ar - br) + (ag - bg) * (ag - bg) + (ab - bb) * (ab - bb)) < sense 'пока точка белая While ((x1 <> x) And (y1 <> y)) 'пока не вернулся к исходной точке If Sqr((ar - br) * (ar - br) + (ag - bg) * (ag - bg) + (ab - bb) * (ab - bb)) > sense Then ' если точка черная raw.Begin(DrawingArea1)
raw.ForeColor = &HFFFFFF
draw.FillStyle = 1 raw.Point(x1, y1)
raw.End
x1 = x1 + sdvig y1 = y1 + sdvig Else x1 = x1 - sdvig y1 = y1 - sdvig End If ar = (((im2[x1, y1])) Mod 256) 'dev br = ((im[x1, y1]) Mod 256) 'im ag = (((im2[x1, y1]) \ 256) Mod 256) bg = (((im[x1, y1]) \ 256) Mod 256) ab = ((((im2[x1, y1]) \ 256) \ 256) Mod 256) bb = ((((im[x1, y1]) \ 256) \ 256) Mod 256) Wend ' DrawingArea1.Clear Timer1.Enabled = True End и не работает 
|
||
|
Номер ответа: 4 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #4 | Добавлено: 27.08.09 00:58 |
| а так а в чем разница, если белый сделаю невидимым, как обведу (ну и получу координаты 4-х крайних точек) всех черных фигур? | ||
|
Номер ответа: 5 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #5 | Добавлено: 27.08.09 01:00 |
|
может попробовать алгоритм "скелетизации"?
Видел на сишке исходники, только в VB перевести не получилось ... |
||
|
Номер ответа: 6 Автор ответа: EROS Вопросов: 58 Ответов: 4255  |
Профиль | | #6 | Добавлено: 27.08.09 01:03 |
| ExtFloodFill | ||
|
Номер ответа: 7 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #7 | Добавлено: 27.08.09 01:12 |
|
не подойдет, необходимо обойтись без библиотек
например, как в листинге 4, по ссылке http://www.ref.by/refs/67/15257/1.html или http://ocrai.narod.ru/vectory.html в идеале как на http://www.pages.drexel.edu/~weg22/edge.html, но в vb 6.0 хотя самый простой и быстрый алгоритм как в описании вопроса (только не получается до ума довести
|
||
|
Номер ответа: 8 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #8 | Добавлено: 27.08.09 01:14 |
| описал - то просто, но вот несколько перекликающихся друг с другом циклов сбивают напрочь | ||
|
Номер ответа: 9 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #9 | Добавлено: 27.08.09 01:18 |
| хотя, если подскажешь, как получить 3 - 8 самых крайних точек нескольких черных областей на белом окружающем фоне, то буду признателен | ||
|
Номер ответа: 10 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #10 | Добавлено: 27.08.09 11:34 |
|
Переделал, поналяпал GoTo, но работает не до конца
For x = 0 To xmax For y = 0 To ymax x1 = x y1 = y If black = true Then raw.Begin(DrawingArea1)
raw.ForeColor = &HFFFFFF
draw.FillStyle = 1 raw.Point(x1, y1)
raw.End
x1 = x - 1 y1 = y - 2 Goto kontur Else End If Next Next kontur: x1 = x1 + 1 If black = true Then issense = True raw.Begin(DrawingArea1)
raw.ForeColor = &HFFFFFF
draw.FillStyle = 1 raw.Point(x1, y1)
raw.End
Else issense = False End If Select Case issense Case False y1 = y1 + 1 If y1 = y Then Goto konkontur Goto kontur Case Else y1 = y1 - 1 Goto kontur End Select konkontur: |
||
|
Номер ответа: 11 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #11 | Добавлено: 27.08.09 11:37 |
| сможете помочь до ума довести? | ||
|
Номер ответа: 12 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #12 | Добавлено: 27.08.09 14:48 |
|
как я представляю себе этот алгоритм:
ползет жук по прямоугольному полю в цикле x, например, вложенному в цикл y, с каким - то заданным шагом в несколько пикселей на поле несколько камней разной формы, в определенной итерации он натыкается на какой-либо камень, начинает его обход (с шагом 1 пиксель), пока не вернется в исходную точку далее - телепортируется сквозь камень в другой его полюс и продолжает идти по прежнему пути, пока не наткнется на след камень, и начнет обход если он встретил уже обойденный камень, то он опять же телепортируется в другой его конец, продолжая путь с каким-то заданным шагом в несколько пикселей и так , пока не закончится его прямоугольное поле |
||
|
Номер ответа: 13 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #13 | Добавлено: 28.08.09 00:38 |
| неужели гениев нет на этом форуме? | ||
|
Номер ответа: 14 Автор ответа: SmithICQ: adamis@list.ru Вопросов: 153 Ответов: 3632 |
Профиль | | #14 | Добавлено: 28.08.09 00:56 |
Есть парочка, но чет они молчат 
|
||
|
Номер ответа: 15 Автор ответа: portCВопросов: 14 Ответов: 101 |
Web-сайт: Профиль | | #15 | Добавлено: 28.08.09 01:03 |
|
Smith, может ты посоветуешь, мне всего на всего нужно получить 4 координаты каждой фигуры на изображении (самую верхнюю, нижнюю правую, левую)
понимаю, что нужно в двойном вложенном цикле, в массив записывать и сравнивать самая верхняя - является точкой вхождения с остальными точками и с отличием, что точки принадлежат именно этой фигуре , вроде тоже более менее понятно, только вот в правильный алгоритм/код превратить не получается раз семь разные варианы писал - все не то
|
||