| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4605 人关注过本帖
标题:VB中给圆填充颜色的算法怎么写
只看楼主 加入收藏
落日幻影
Rank: 1
等 级:新手上路
帖 子:36
专家分:0
注 册:2013-10-10
收藏
得分:0 
回复 10楼 lowxiong
我先不管怎么拖动画圆了,先画两个现成的圆,我写了这段代码,可以实现在一个区域内点一下可以画出一条直线,但怎么写可以把这个区域一这样画线的方式填充好,我试着谢了好几次都不行,前辈帮我补充一下
Dim rgbColor As String
Dim dr As Single
Dim dg As Single
Dim db As Single
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    rgbColor = Hex(Me.Point(x, y))
    rgbColor = Change2RGB(rgbColor)
    Call printline(x, y)
   
End Sub



Private Sub Form_paint()
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Circle (2000, 2000), 1000, RGB(0, 0, 0)
    Circle (2800, 2800), 1000, RGB(0, 0, 0)
End Sub


Private Function printline(x As Single, y As Single)
   
    Dim lx As Single
    Dim ly As Single
    Dim rx As Single
    Dim ry As Single
    Dim loopflag As Boolean
    loopflag = True
    lx = x - 1
    Do While loopflag
        If Change2RGB(Me.Point(lx, y)) <> rgbColor Then
            loopflag = False
        Else
            lx = lx - 1
        End If
    Loop
   
    loopflag = True
    rx = x + 1
    Do While loopflag
        If Change2RGB(Me.Point(rx, y)) <> rgbColor Then
            loopflag = False
        Else
            rx = rx + 1
        End If
    Loop
    Me.Line (lx, y)-(rx, y), RGB(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text))
End Function

Private Function Change2RGB(c As String)
    Select Case Len(c)
        Case 1: Change2RGB = "00000" & c
        Case 2: Change2RGB = "0000" & c
        Case 3: Change2RGB = "000" & c
        Case 4: Change2RGB = "00" & c
        Case 5: Change2RGB = "0" & c
    End Select
End Function
2013-10-24 13:50
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:652
专家分:3402
注 册:2008-5-7
收藏
得分:0 
帮你调试弄了下,可以填充,有一定失败率,主要是因为缇和像素的原因(1像素=15缇,你必须每次坐标位置都是像素的整数倍才行)

Dim rgbColor As Long
Dim dr As Single
Dim dg As Single
Dim db As Single
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    rgbColor = Me.Point(x, y)
    printline x, y
End Sub

Private Sub Form_paint()
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Circle (2000, 2000), 1000, RGB(0, 0, 0)
    Circle (2800, 2800), 1000, RGB(0, 0, 0)
End Sub


Private Function printline(x As Single, y As Single)
    '本函数被递归调用
    Dim lx As Single
    Dim ly As Single
    Dim rx As Single
    Dim ry As Single
    Dim loopflag As Boolean
    Dim i As Single, y1 As Single
    If Me.Point(x, y) <> rgbColor Then Exit Function
    lx = x
    While Me.Point(lx, y) = rgbColor
      lx = lx - 15
    Wend
    lx = lx + 15
    rx = x
    While Me.Point(rx, y) = rgbColor
      rx = rx + 15
    Wend
    rx = rx - 5
    Me.Line (lx, y)-(rx, y), RGB(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text))
    y1 = y - 15
    For i = lx To rx Step 15
      If Me.Point(i, y1) = rgbColor Then
        printline i, y1
        Exit For
      End If
    Next
    y1 = y + 15
    For i = lx To rx Step 15
      If Me.Point(i, y1) = rgbColor Then
        printline i, y1
        Exit For
      End If
    Next
End Function
2013-10-24 15:43
落日幻影
Rank: 1
等 级:新手上路
帖 子:36
专家分:0
注 册:2013-10-10
收藏
得分:0 
回复 12楼 lowxiong
真的非常感谢前辈,麻烦你了
2013-10-24 15:56
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:652
专家分:3402
注 册:2008-5-7
收藏
得分:0 
回复 13楼 落日幻影
你这种算法只能填规则图形,如果非规则图形就会填不满,完整填充算法应该是我10楼的代码。
2013-10-24 16:40
落日幻影
Rank: 1
等 级:新手上路
帖 子:36
专家分:0
注 册:2013-10-10
收藏
得分:0 
回复 14楼 lowxiong
真的很感谢前辈
2013-10-25 15:04
快速回复:VB中给圆填充颜色的算法怎么写
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.016847 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved