如何勾勒图形的轮廓。

[huxiangming]

在一个白色图上有若干个黑色的圆，三角，线等其他不规则的图形，如何才能勾勒这些图形的边缘，并得到这些图形的面积，周长等参数。
提供思路也可。

[方工]

前提：
图形是封闭的吗？
图形有没有交叉、包含？

[huxiangming]

封闭的,而且是独立的。但会有多个。

[canyqf]

判断一图形上点周围的点是不是全为图形的颜色，不是即为边界了

[daviddivad]

gz

[KAIBate]

关注ing...

[方工]

到数据结构和算法论坛，高手云集

[huxiangming]

能详细点吗？或者告诉我地方也可以呀。

[xiaoxinghappy]

遍历每一个点，把颜色各背景色不同的内容分离出来，一般图形怪异窗体都是这么做的。

不好意思，拷贝过来时的注释变成了乱码，win2k的BUG。

Attribute VB_Name = "mdlMakeRange"
Option Explicit

Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Public Const RGN_OR = 2
Public Const ALTERNATE = 1 ' ALTERNATE and WINDING are

Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Public Type POINTAPI
X As Long
Y As Long
End Type


Public Sub SetAutoRgn(hForm As Form, hbm As Long, Optional transColor As Byte = vbNull)
Dim X As Long, Y As Long
Dim Rgn1 As Long, Rgn2 As Long
Dim SPos As Long, Epos As Long, SPos1 As Long, Epos1 As Long
Dim bm As BITMAP
'Dim hbm As Long
Dim Wid As Long, hGt As Long
Dim Bind As Boolean
Dim bmByte() As Byte
Dim Pt(0 To 3) As POINTAPI
Bind = False
' »ñÈ¡´°Ìå±³¾°Í¼Æ¬³ß´ç
'hbm = hForm.Pic
If hbm = 0 Then Exit Sub
GetObject hbm, Len(bm), bm
Wid = bm.bmWidth
hGt = bm.bmHeight
'¸Ä±ä´°Ìå³ß´çÒÔ·ûºÏ±³¾°Í¼Æ¬´óС
hForm.Height = hGt * Screen.TwipsPerPixelY
hForm.Width = Wid * Screen.TwipsPerPixelX
' Rgn1 = CreateRectRgn(0, 0, hGt, Wid)
' SetWindowRgn hForm.hWnd, Rgn1, True
ReDim bmByte(1 To bm.bmWidthBytes, 1 To hGt)
SetWindowRgn hForm.hWnd, Rgn1, True
GetBitmapBits hbm, bm.bmWidthBytes * hGt, bmByte(1, 1) '»ñȡͼÏñÊý×é
'Èç¹ûûÓд«Èë transColor ²ÎÊý,ÔòÓõÚÒ»¸öÏñËØ×÷Ϊ͸Ã÷É«
If transColor = vbNull Then transColor = bmByte(1, 1)
Rgn1 = CreateRectRgn(0, 0, 0, 0)
For Y = 1 To hGt 'ÖðÐÐɨÃè
X = 0
Do
X = X + 1
While (bmByte(X, Y) = transColor) And (X < Wid) '((bmByte(X, Y) >= transColor - 2) And (bmByte(X, Y) <= transColor + 2)) And (X < Wid)
X = X + 1 'Ìø¹ý͸Ã÷É«µÄµã
Wend
If X < Wid Then
SPos = X
While (bmByte(X, Y) <> transColor) And (X < Wid) '((bmByte(X, Y) <= transColor - 2) Or (bmByte(X, Y) >= transColor + 2)) And (X < Wid)
X = X + 1 'Ìø¹ý²»Í¸Ã÷µÄµã
Wend
Epos = X - 1
'ÕâÒ»¶ÎÊǺϲ¢ÇøÓò
' If SPos <= Epos Then
' If Bind Then
' Pt(2).x = SPos
' Pt(2).y = y
' Pt(3).x = Epos
' Pt(3).y = y
Rgn2 = CreateRectRgn(SPos, Y, Epos, Y + 1)
'Rgn2 = CreatePolygonRgn(Pt(0), 4, 1)
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
DeleteObject Rgn2
' Bind = False
' Else
' Pt(0).x = SPos
' Pt(0).y = y
' Pt(1).x = Epos
' Pt(1).y = y
' Bind = True
' End If
' End If
End If
Loop Until X >= Wid
Next Y
Erase bmByte
'É趨´°ÌåÐÎ×´ÇøÓò
SetWindowRgn hForm.hWnd, Rgn1, True
DeleteObject Rgn1
End Sub

[skywolfY]

大概思路就是遍历了，取得RGB色，把同行相同的标上一样的号，再把同列相同的
改成上行的号，然后算出相同标号的个数，一个就是一个象素点，同号的相加就是
面积了。周长等等，都可以这样做，还可以设个大小限制，去掉大于某一面积或是
小于某一面积的图形。
勾勒图形的轮廓是在这个基础上把相邻标号的象素点去掉，再写上边界的象素点
有这方面的书的，只可惜我不记得名字了

[笨笨2011]

Up

[handsomge]

好象有个移位XOR算法，昨天听别人说的

[xiaoxinghappy]

其实上面发的程序已经实现了遍历了，取得了RGB 颜色，去掉MARK 的颜色，比如说去掉白色，你可以在FORM 上加载一幅图片，图版就有你说的圆形或三角形周边用明显的颜色分开。然后在FORM_LOAD的时候加入这一句:SetAutoRgn(Form1, Form1.Picture).这时就可以看出效果了.

[huxiangming]

xiaoxinghappy(小星) :能发我程序吗？我贴下来后不能运行。
Email:[e-mail]

[xiuqiu]

picturebox:Source --->picture:Dest
Cancel = False
StartLineArt.Enabled = False
StartEdgeDetect.Enabled = False
Dim Col As Long ' hold the colour of the pixel minus the colour of the pixel next to it
Dim Total As Long
Total = (Source.Width / Screen.TwipsPerPixelX) * (Source.Height / Screen.TwipsPerPixelY)
Dest.Cls
For x = 1 To Source.Width \ Screen.TwipsPerPixelX 'loop through the x-pixels
For y = 1 To Source.Height \ Screen.TwipsPerPixelY 'loop through the y-pixels
Col = Abs(GetPixel(Source.hdc, x, y) - GetPixel(Source.hdc, x, y - 1)) ' hold the colour of the pixel minus the colour of the pixel on the top of it
If Col > (Tolerance.Value) ^ 3 Then Col = vbWhite Else Col = 0 ' choose if the colour is of high contrast
If Invert.Value = 0 Then Col = (vbWhite - Col) ' check for an invert
If Col = 0 Then SetPixel Dest.hdc, x, y, Col ' plot pixel
Col = Abs(GetPixel(Source.hdc, x, y) - GetPixel(Source.hdc, x - 1, y)) ' hold the colour of the pixel minus the colour of the pixel on the left of it
If Col > (Tolerance.Value) ^ 3 Then Col = vbWhite Else Col = 0 ' choose if the colour is of high contrast
If Invert.Value = 0 Then Col = (vbWhite - Col) ' check for an invert
If Col = 0 Then SetPixel Dest.hdc, x, y, Col ' plot pixel
Next y 'loop through the y-pixels
PercentDone.Caption = Int(((x * y) / Total) * 100) & "%" 'calculate the percent done.
Dest.Refresh
DoEvents
If Cancel = True Then GoTo Finish:
Next x 'loop through the x-pixels
Finish:
StartLineArt.Enabled = True
StartEdgeDetect.Enabled = True