这是VBA识别地图边界的代码，我就纳了闷了，为什么每次得出的结果都不一样呢？谢谢

cumulonimbus · 发表于 2012-10-7 20:05

本帖最后由 cumulonimbus 于 2012-10-8 13:18 编辑

这是VBA识别地图边界的代码，我就纳了闷了，为什么每次得出的结果都不一样呢？谢谢
根据这个网站的代码改编
http://topic.csdn.net/u/20090511/17/535ba985-8eb3-4d07-8010-a22cec06627c.html
希望有人能够指点迷津。

地图.rar (20.75 KB, 下载次数: 51)

未命名.JPG

joforn · 发表于 2012-10-8 12:10

你这个图片是JPG的，你先在程序中把图片处理成黑白的图片，然后根据黑色取得一个座标数组，最后用取得的座标数组创建一个多边形区域，此区域就为地图中的区域。如果要描边的话，使用区域描边就OK了。

cumulonimbus · 发表于 2012-10-8 13:13

本帖最后由 cumulonimbus 于 2012-10-8 13:19 编辑

joforn 发表于 2012-10-8 12:10
你这个图片是JPG的，你先在程序中把图片处理成黑白的图片，然后根据黑色取得一个座标数组，最后用取得的座标 ...

大侠，我这个图片就是黑白图片呀，要怎么弄？给个例子
我这个在窗体上按了鼠标，就成这样了，而且每一次都不同
未命名.JPG

lu_zhao_long · 发表于 2012-10-10 18:54

cumulonimbus 发表于 2012-10-8 13:13
大侠，我这个图片就是黑白图片呀，要怎么弄？给个例子
我这个在窗体上按了鼠标，就成这样了，而且每一 ...

这是文件中的一段 VBA 代码，楼主可以自己去分析吧：
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
   Dim lColor As Long
   Dim i As Long, j As Long, idx As Long
   Dim m As Long, n As Long, f As Long
   Dim ptMargin() As POINTAPI, ptIdx As Long

   'ÓÃ±³¾°Ë¢Ìî³ä¸ÃÇøÓò
   ExtFloodFill m_hMemDC, x, y, GetPixel(m_hMemDC, x, y), FLOODFILLSURFACE
   '»ñµÃÌî³äºóµÄÇøÓòÖÖ×ÓÑÕÉ«
   lColor = GetPixel(m_hMemDC, x, y)
   '±éÀúÄÚ´æÎ»Í¼²éÑ¯Ìî³äÇøÓòµÄ±ß½ç
   ptIdx = -1
   m = IIf(x - 150 < 0, 0, x - 150)
   n = IIf(y - 120 < 0, 0, y - 120)
   For j = n To y + 120
      f = 0
      For i = m To x + 150
         If GetPixel(m_hMemDC, i, j) = lColor Then
               If f = 0 Then 'ÕÒµ½×î×óµÄ±ß½çµã
                  f = 1
                  ptIdx = ptIdx + 1
                  ReDim Preserve ptMargin(ptIdx)
                  ptMargin(ptIdx).x = i
                  ptMargin(ptIdx).y = j
               End If
         Else
               If f = 1 Then 'ÕÒµ½×îÓÒµÄ±ß½çµã
                  f = 0
                  ptIdx = ptIdx + 1
                  ReDim Preserve ptMargin(ptIdx)
                  ptMargin(ptIdx).x = i - 1
                  ptMargin(ptIdx).y = j
               End If
         End If
      Next
   Next
   'È¡ÏûÌî³ä
   ExtFloodFill m_hMemDC, x, y, GetPixel(m_hMemDC, x, y), FLOODFILLSURFACE
   'ÑéÖ¤½á¹û£¬ÓÃ±ß½çµãÊýÃè»æ±ß½çÏß
   For i = 0 To ptIdx
      SetPixelV hdc, ptMargin(i).x, ptMargin(i).y, vbRed
      ' Me.PSet (ptMargin(i).x, ptMargin(i).y), vbRed
   Next
End Sub

cumulonimbus · 发表于 2012-10-10 21:52

本帖最后由 cumulonimbus 于 2012-10-10 21:54 编辑

地图.rar (69.96 KB, 下载次数: 10)

2012-10-10 21:53 上传
点击文件名下载附件

lu_zhao_long 发表于 2012-10-10 18:54
这是文件中的一段 VBA 代码，楼主可以自己去分析吧：
Private Sub UserForm_MouseUp(ByVal Button As In ...

大哥，辛苦啦。{:soso_e163:}
我运行了你的代码，发现你的代码运行的效果与我的代码一模一样，头痛呀，想不通是怎么回事儿。
本来我想代码的效果：每个省点一下省边界内，就会在这个省原边界用红色描绘出红色边界，点完所有的省，就会跑出一幅中国地图。可是做不到，老是移位，并出现色直线。恐怕这是VBA的局限吧

Moneky · 发表于 2012-10-10 23:39

本帖最后由 Moneky 于 2012-10-10 23:53 编辑

可能是代码中的坐标转换问题，将窗体picturealignment属性设置为0，将图片置于左上角后，没有发生偏移现象，但还是有些问题，楼主仔细再看看代码吧
另外，vba中窗体mouse_up事件中的返回的x，y值的单位应该不是楼主所预期的，建议看看winland版主在http://club.excelhome.net/forum.php?mod=viewthread&tid=203573的转换代码

cumulonimbus · 发表于 2012-10-11 10:46

Moneky 发表于 2012-10-10 23:39
可能是代码中的坐标转换问题，将窗体picturealignment属性设置为0，将图片置于左上角后，没有发生偏移现象， ...

能帮忙改改么

Moneky · 发表于 2012-10-11 11:14

cumulonimbus 发表于 2012-10-11 10:46
能帮忙改改么

看着太繁琐了，自己改改吧

cumulonimbus · 发表于 2012-10-11 11:32

Moneky 发表于 2012-10-11 11:14
看着太繁琐了，自己改改吧

谢谢，我试试

xman2000 · 发表于 2019-8-20 23:05

你好这个大纲的任何更新 VBA？

非常重要且非常有用

		自动登录	找回密码
密码			免费注册

[求助] 这是VBA识别地图边界的代码，我就纳了闷了，为什么每次得出的结果都不一样呢？谢谢

评分