画直线问题（焦急等待中……）

Question

刚刚接触vb，有许多东西还不但明白，请问怎么用描点的方法画直线（不调用line）。我在编一个类似画图的东西，画直线怎么也实现不了。请高手指点一二，感激不尽。

Answer 1

例如：Private Sub Form_Click()
dim a as single,b as single
dim dX as single,dY as single
me.Scale (-100,100)-(100,-100)
a=3
b=10
for dX=-100 to 100
dY=a*x+b
me.pset (dX,dY),vbred
'在Picturebox里用picture1.pset (dX,dY)
next
End sub

Answer 2

Private Sub Form_Click()
dim a as single,b as single
dim dX as single,dY as single
me.Scale (-100,100)-(100,-100)
a=3
b=10
for dX=-100 to 100
dY=a*dX+b
me.pset (dX,dY),vbred
'在Picturebox里用picture1.pset (dX,dY)
next
End sub

Answer 3

要求用鼠标画按照扫描直线的中点算法：
                       dx = xnow - x0;
                       dy = ynow - y0;
                       d = dx - 2 * dy
                       incrE = -2 * dy
                       incrNE = 2 * (dx - dy)
                       x=x0,y=y0;
                       PutPixel(x,y);
                       while(x<x1)
                      {   if(d>0) 
                           d = d + incrE                               
                           else                                                   
                           {d+=incrNE;
                            x++;
                            y++;
                            }
                      PutPixel(x,y)；
                      }     
麻烦你在看看。

Answer 4

这是VB，不是C啊！！！！
VB里就用VB的东西。
用鼠标画的例子如下~~不太完美，呵Dim Dx As Single, Dy As Single, isDown As BooleanPrivate Sub Form_Load()
Picture1.Scale (-1000, 1000)-(1000, -1000)
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dx = X
Dy = Y
isDown = True
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ThisX As Single, ThisY As Single
If isDown = True And X <> Dx Then
Picture1.Cls
If X > 0 Then
For ThisX = -X To X
ThisY = ThisX * (Y - Dy) / (X - Dx)
Picture1.PSet (ThisX, ThisY)
Next
Else
For ThisX = X To -X
ThisY = ThisX * (Y - Dy) / (X - Dx)
Picture1.PSet (ThisX, ThisY)
Next
End If
End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
isDown = False
End Sub

Answer 5

用line画效果会更好点：Dim Dx As Single, Dy As Single, isDown As BooleanPrivate Sub Form_Load()
Picture1.Scale (-1000, 1000)-(1000, -1000)'定义坐标系统
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dx = X    '取得鼠标按下时的X和Y点坐标
Dy = Y
isDown = True  '告诉系统,鼠标已经按下
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ThisX As Single, ThisY As Single
If isDown = True And X <> Dx Then
Picture1.Cls                     '清屏
Picture1.Line (X, Y)-(Dx - X, Dy - Y)     '以鼠标按下点为中心画线
End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
isDown = False    '如果松开鼠标就记录下最后一条线
End Sub

Answer 6

mouseDown代码段这样改可能会好点:Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If isDown = False Then
Dx = X    '取得鼠标按下时的X和Y点坐标
Dy = Y
isDown = True  '告诉系统,鼠标已经按下
End If
End Sub

Answer 7

Option Explicit
    
    Dim i, drawact As Integer
    Dim canline, canpen, canrubber, canenlarge, canellipse, canrectangle, canflood, canget, canbrush As Boolean
    Dim x0, y0, xnow, ynow, radius0, radius As Single
    Dim Filename As String
    
    Private Sub Form_Load()
        
        ' 初始化图片筐大小和autodraw属性和窗提标题
        Picture3.Width = Picture1.Width
        Picture3.Height = Picture1.Height
        Picture1.AutoRedraw = True
        Picture3.AutoRedraw = True
        Picture1.Picture = LoadPicture()
        Filename = "Untitled"
        Form1.Caption = Filename
    
    End Sub
    
    Private Sub Label2_Click(Index As Integer)
        
        ' 选择某项操作，将其下凹看上去像是被按下去的
        For i = 0 To Label2.Count - 1
            Label2(i).BorderStyle = 0
        Next
        Label2(Index).BorderStyle = 1
        drawact = Index
    
    End Sub
    
    
    
    
    
    Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        
        ' 党鼠标按下时，对于不同工具，执行不同操作
        Select Case drawact
            ' 橡皮
            Case 0
                canrubber = True
                Picture1.CurrentX = X: Picture1.CurrentY = Y
                Picture1.DrawMode = 13
                Picture1.DrawWidth = 7
            ' 直线
            Case 1
                canline = True
                x0 = X: y0 = Y
                xnow = X: ynow = Y
                Picture1.DrawMode = 7
                Picture1.DrawWidth = 1
            ' 矩形
            Case 2
                canrectangle = True
                x0 = X: y0 = Y
                xnow = X: ynow = Y
                Picture1.DrawMode = 7
                Picture1.DrawWidth = 2
            ' 椭圆
            Case 3
                canellipse = True
                x0 = X: y0 = Y
                xnow = X: ynow = Y
                Picture1.DrawMode = 7
                Picture1.DrawWidth = 1
            '   铅笔
          Case 4
                canpen = True
                Picture1.CurrentX = X: Picture1.CurrentY = Y
                Picture1.DrawMode = 13
            ' 刷子
            Case 5
                canbrush = True
                Picture1.CurrentX = X: Picture1.CurrentY = Y
                Picture1.DrawMode = 13
                Picture1.DrawWidth = 5
            ' 油漆桶
            Case 6
                Picture1.BackColor = Label1.BackColor
            ' 放大镜
            Case 7
                canenlarge = True
                x0 = X: y0 = Y
                xnow = X: ynow = Y
                Picture1.DrawMode = 7
                Picture1.DrawWidth = 1
        End Select
    
    End Sub
    
    Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        
        ' 在标签中显示当前鼠标在画板中的位置
        Label3.Caption = "X: " + CStr(X) + Chr(13) + Chr(10) + "Y: " + CStr(Y)
        ' 党鼠标按下时，对于不同工具，执行不同操作
        Select Case drawact
            ' 橡皮
            Case 0
                If canrubber Then
                    Picture1.Line -(X, Y), vbWhite
                End If
            ' 直线
            Case 1
                If canline Then
                    Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor)
                    Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor)
                    xnow = X: ynow = Y
                End If
            ' 矩形
            Case 2
                If canrectangle Then
                    Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
                    Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor), B
                    xnow = X: ynow = Y
                End If
            ' 椭圆
            Case 3
                    radius0 = Sqr((xnow - x0) ^ 2 + (ynow - y0) ^ 2)
                    radius = Sqr((X - x0) ^ 2 + (Y - y0) ^ 2)
                If canellipse Then
                    Picture1.Circle (x0, y0), radius0, Not (Picture1.ForeColor)
                    Picture1.Circle (x0, y0), radius, Not (Picture1.ForeColor)
                    xnow = X: ynow = Y
                End If
            ' &Ccedil;&brvbar;±&Ecirc;
            Case 4
                If canpen Then
                    Picture1.Line -(X, Y), Picture1.ForeColor
                End If
            ' &Euml;&cent;×&Oacute;
            Case 5
                If canbrush Then
                    Picture1.Line -(X, Y), Picture1.ForeColor
                End If
            ' &Oacute;&Iacute;&AElig;á&Iacute;°
            Case 6
                ' do nothing
            ' ·&Aring;&acute;ó&frac34;&micro;
            Case 7
                If canenlarge Then
                    Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
                    Picture1.Line (x0, y0)-(X, Y), Not (Picture1.ForeColor), B
                    xnow = X: ynow = Y
                End If
        End Select
    
    End Sub
    
    Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        
        ' 党鼠标按下时，对于不同工具，执行不同操作
        Select Case drawact
            Case 1
                canline = False
                Picture1.Line (x0, y0)-(xnow, ynow)
                Picture1.DrawMode = 13
                Picture1.Line (x0, y0)-(xnow, ynow), Picture1.ForeColor
            Case 2
                canrectangle = False
                Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
                Picture1.DrawMode = 13
                Picture1.Line (x0, y0)-(xnow, ynow), Picture1.ForeColor, B
            Case 3
                canellipse = False
                Picture1.Circle (x0, y0), radius, Not (Picture1.ForeColor)
                Picture1.DrawMode = 13
                Picture1.Circle (x0, y0), radius, Picture1.ForeColor
            Case 4
                canpen = False
            Case 5
                canbrush = False
            Case 7
                canenlarge = False
                Picture1.Line (x0, y0)-(xnow, ynow), Not (Picture1.ForeColor), B
                Picture3.PaintPicture Picture1.Image, 0, 0, Picture3.Width, Picture3.Height, x0, y0, (xnow - x0), (ynow - y0)
                Picture1.PaintPicture Picture3.Image, 0, 0
        End Select
    
    End Sub
    
    
    Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
        ' 通过point方法取色，并设为前景色
        Picture1.ForeColor = Picture2.Point(X, Y)
        Label1.BackColor = Picture2.Point(X, Y)
    
    End Sub
   
   这是我程序代码部分的主要部分，可以运行
我希望，把用line画的直线用描点的方法实现，鼠标第一次按下时就是起点，移动画直线，松开时确定直线。

Answer 8

把
{d+=incrNE;
                            x++;
                            y++;
                            }
换成{d+1=incrNE;
        x=x+1
       y=y+1
              }试试
若是．net版本就没办法拉

Answer 9

为什么不用LINE画,用点画速度根不上~~

Answer 10

Picture1.DrawWidth = 5
   Picture1.PSet (100, 100), vbBlack'

Answer 11

你是不是要这种效果?
试试下面的代码：Dim a As Boolean
Dim Xo, Yo As Single
Dim Xn, Yn As SinglePrivate Sub Form_Load()
Me.AutoRedraw = True
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Xo = X
Yo = Y
Xn = X
Yn = Y
a = True
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If a = True Then
Me.AutoRedraw = False
Me.Line (Xn, Yn)-(X, Y)
Xn = X
Yn = Y
End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = False
Me.Refresh
Me.AutoRedraw = True
Me.Line (Xo, Yo)-(Xn, Yn), Me.ForeColorEnd Sub

Answer 12

如果还不行可以用“层”的概念来画，也就是用二个甚至多个Picturebox来画，直到满意了才将图形copy到一起去~呵

Answer 13

LineTo
也许楼主需要的是这个

Answer 14

其实我的意思是不用line自己写一个同line功能相同的，用于化直线。再写一个反走样功能（这个先不考虑）。