我想找个画线控件，咋弄呀，太复杂了，谢谢了求求大家了

Question

我做了3个自定义控件A，B，C， 每个有2个端点， 我要用这个画线控件把几个东西任意端口连接起来， 划先要求不高，就是直线就行，斜线可以拐弯方式实现， 但目前的主要问题是我的A，B， C控件自己可以编写，例如定义A控件2个端口，当CLICK 一个后我通过改变他状态方式记录用户是否画线了，但如果用户删除了连线后，我的把他的状态改为“空闲” ，就是在画线控件里raise event 个事件，通知A控件释放端口，实在是太复杂了， 目前我没有这个画线的控件呀，有现成的吗 ，我点一下此控件进入画线状态，关键是我还要让他知道它的两点是和 A,B ,C 哪个连的呀

Answer 1

划线不难啊？最简单的就是用MSChart控件了：
http://download.csdn.net/detail/veron_04/1483925
不过，一般还是用PictureBox：
http://download.csdn.net/detail/veron_04/2368159
如果你是在要用控件，也不难，那就是加载一系列Line控件，将其首尾连接起来即可。

Answer 2

我还没积分呀，看不见呀，加我QQ729127579，谢谢了Veron_04

Answer 3

Option Explicit
'对于二维散点图来说，第一列代表了X轴坐标，第二列代表了Y轴坐标
'因此在定义二维数据时，第二维定义为0到1，第一维代表了第几点数据，可根据数据点数变化
'下面以数据点数有21点为列子
Dim MyData(360, 1) As Variant
Dim DataT(360, 1) As Variant
Private Const PI = 3.1415926
Dim intC As Integer
Dim dblStep As DoublePrivate Sub Command1_Click()
    Timer1.Enabled = Not Timer1.Enabled
    If Timer1.Enabled Then Command1.Caption = "停止示波器"
    If Not Timer1.Enabled Then Command1.Caption = "启动示波器"
End SubPrivate Sub Form_Load()
    Dim I As Integer
    dblStep = 8 * PI / 360
    '-----x轴坐标值-----Y轴坐标值----------
    For I = 0 To 360
        MyData(I, 0) = I
        MyData(I, 1) = 149 * Sin(dblStep * I) + 150
    Next I
    For I = 0 To 360
        DataT(I, 0) = I
        DataT(I, 1) = 149 * Cos(dblStep * I) + 150
    Next I
    intC = 1
    '波形图外观设置
    With MSChart1
        .TitleText = "速度 m/min"
        '    '设置图线的外观
        .Plot.SeriesCollection(1).Pen.Width = 40
        .Plot.SeriesCollection(1).Pen.Style = VtPenStyleSolid
        '    '设置XY轴
        .Plot.Axis(VtChAxisIdX).ValueScale.Auto = False
        .Plot.Axis(VtChAxisIdY).ValueScale.Auto = False
        '// 设置最大值
        .Plot.Axis(VtChAxisIdX).ValueScale.Maximum = 360
        .Plot.Axis(VtChAxisIdY).ValueScale.Maximum = 300
        '// 设置最小值
        .Plot.Axis(VtChAxisIdY).ValueScale.Minimum = 0
        .Plot.Axis(VtChAxisIdX).ValueScale.Minimum = 0
        '//
        .Plot.Axis(VtChAxisIdX).ValueScale.MajorDivision = 6 'X轴主要网格数量
        .Plot.Axis(VtChAxisIdY).ValueScale.MajorDivision = 6 'Y轴主要网格数量
        .Plot.Axis(VtChAxisIdX).ValueScale.MinorDivision = 0 'X轴次要网格数量
        .Plot.Axis(VtChAxisIdY).ValueScale.MinorDivision = 0 'Y轴次要网格数量
'        .Plot.Axis(VtChAxisIdX).AxisGrid.MajorPen.Style = VtPenStyleDotted
'        .Plot.Axis(VtChAxisIdY).AxisGrid.MajorPen.Style = VtPenStyleDotted
        MSChart1.Plot.AutoLayout = False
        MSChart1.Plot.UniformAxis = False
        MSChart1.chartType = VtChChartType2dXY '设置图形为二维散点图
        MSChart1.ChartData = MyData '数据
    End With
End SubPrivate Sub MSChart1_ChartSelected(MouseFlags As Integer, Cancel As Integer)
    Text1.Text = MouseFlags
End SubPrivate Sub MSChart1_LegendSelected(MouseFlags As Integer, Cancel As Integer)End SubPrivate Sub MSChart1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    Text1.Text = "X=" & CStr(X) & "   Y=" & CStr(Y)
End SubPrivate Sub Timer1_Timer()
    Dim intP As Integer
    For intP = 0 To 359
        MyData(intP, 1) = MyData(intP + 1, 1)
    Next intP
    MyData(360, 1) = 149 * Sin(intC * dblStep) + 150
    intC = (intC + 1) Mod 360
    MSChart1.ChartData = MyData
End Sub

Answer 4

Option ExplicitDim K As Double
Dim lngX As Long            'X的值
Dim dblY As Double          'Y的值
Dim L As Long               '绘图区域的宽
Dim H As Long               '绘图区域的高
Dim lngMemoryDC1 As Long     '内存中绘图的设备场景的句柄
Dim lngMemoryDC2 As Long     '内存中绘图的设备场景的句柄
Dim lngBMPHandle1 As Long    '位图的句柄
Dim lngBMPHandle2 As Long    '位图的句柄
Dim lngBrushHandle1 As Long  '填充刷子的句柄
Dim lngBrushHandle2 As Long  '填充刷子的句柄
Dim hRgn1 As Long            '填充区域的句柄
Dim hRgn2 As Long
Dim lngPen1 As Long          '画笔的句柄
Dim lngPen2 As Long          '画笔的句柄
Private Const PI = 3.1415926            'PI
Private Const DC_L = 1000               '内存设备场景对图片设备场景的倍数,注意，这个数据太大会导致函数执行失败
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCDECIMALBIND = 19
Private Const SRCERASE = &H440328Private Const PS_DOT = 2
Private Const PS_SOLID = 0
Private Const RGN_AND = 1
Private Const RGN_COPY = 5
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4
Private Const HS_DIAGCROSS = 5Private Const R2_BLACK = 1    '  0
Private Const R2_COPYPEN = 13  ' P
Private Const R2_LAST = 16
Private Const R2_MASKNOTPEN = 3 ' DPna
Private Const R2_MASKPEN = 9   ' DPa
Private Const R2_MASKPENNOT = 5 ' PDna
Private Const R2_MERGENOTPEN = 12    ' DPno
Private Const R2_MERGEPEN = 15  ' DPo
Private Const R2_MERGEPENNOT = 14    ' PDno
Private Const R2_NOP = 11    ' D
Private Const R2_NOT = 6 ' Dn
Private Const R2_NOTCOPYPEN = 4 ' PN
Private Const R2_NOTMASKPEN = 8 ' DPan
Private Const R2_NOTMERGEPEN = 2 ' DPon
Private Const R2_WHITE = 16   '  1
Private Const R2_XORPEN = 7   ' DPxPrivate Const TRANSPARENT = 1
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, lppt As POINTAPI, ByVal cPoints As Long) As Long
Private Declare Function PolyBezierTo Lib "gdi32.dll" (ByVal hdc As Long, lppt As POINTAPI, ByVal cCount As Long) As Long
Private Declare Function PolyPolygon Lib "gdi32.dll" (ByVal hdc As Long, lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function GetROP2 Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetDCPenColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal colorref As Long) As Long
Private Declare Function GetDCPenColor Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetDCBrushColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal colorref As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Sub Command1_Click()
    Dim lngP As Long
    If Command1.Caption = "开始" Then
        Timer1.Enabled = True
        Command1.Caption = "停止"
    Else
        Timer1.Enabled = False
        Command1.Caption = "开始"
    End If
End SubPrivate Sub Form_Load()
    Dim intP As Integer
    Dim x As Double
    Dim y As Double
    Dim lngP As Long
On Error GoTo errSub
    L = Picture1.ScaleWidth / 15
    H = Picture1.ScaleHeight / 15
    ReDim A(L)
    K = 4 * PI / L
    dblY = H * 0.5
    
    '％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
    Picture3.ForeColor = vbBlue
    lngMemoryDC1 = CreateCompatibleDC(Picture3.hdc)                  '创建一个与窗体相兼容的设备场景
'    lngMemoryDC1 = CreateDC("WINSPOOL", vbNullString, vbNullString, ByVal 0&)
'    lngBMPHandle1 = CreateCompatibleBitmap(lngMemoryDC1, DC_L * L, H) '在内存中创建与窗体同样大小的位图
    lngBMPHandle1 = CreateBitmap(L, H, 1, 1, ByVal 0&)
    lngP = SelectObject(lngMemoryDC1, lngBMPHandle1)                        '将位图选入刚才创建的设备场景中
    lngBrushHandle1 = CreateSolidBrush(RGB(255, 255, 255))           '用白色创建一个实色画刷
    hRgn1 = CreateRectRgn(0, 0, DC_L * L, H)                         '创建一个与窗体同样大小的矩形区域
    lngP = FillRgn(lngMemoryDC1, hRgn1, lngBrushHandle1)               '用创建的画刷对该区域进行填充
    lngPen1 = CreatePen(PS_SOLID, 2, vbRed)
    lngP = SelectObject(lngMemoryDC1, lngPen1)
    '％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
    Picture2.ForeColor = vbRed
    lngMemoryDC2 = CreateCompatibleDC(Picture2.hdc)                  '创建一个与窗体相兼容的设备场景
    lngBMPHandle2 = CreateCompatibleBitmap(lngMemoryDC2, DC_L * L, H) '在内存中创建与窗体同样大小的位图
    lngP = SelectObject(lngMemoryDC2, lngBMPHandle2)                        '将位图选入刚才创建的设备场景中
    lngBrushHandle2 = CreateSolidBrush(RGB(255, 255, 255))           '用白色创建一个实色画刷
    hRgn2 = CreateRectRgn(0, 0, DC_L * L, H)                         '创建一个与窗体同样大小的矩形区域
    lngP = FillRgn(lngMemoryDC2, hRgn2, lngBrushHandle2)               '用创建的画刷对该区域进行填充
    lngPen2 = CreatePen(PS_SOLID, 2, Picture2.ForeColor)
    lngP = SelectObject(lngMemoryDC2, lngPen2)
    Exit Sub
errSub:
    MsgBox Err.Description
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lngP As Long
    DeleteObject hRgn1               '删除以前创建的对像用于释放内存
    DeleteObject hRgn2
    DeleteObject lngBrushHandle1
    DeleteObject lngBrushHandle2
    DeleteObject lngBMPHandle1
    DeleteObject lngBMPHandle2
    DeleteDC lngMemoryDC1
    DeleteDC lngMemoryDC2
    DeleteObject lngPen1
    DeleteObject lngPen2
End Sub
Private Sub Timer1_Timer()
    Dim lngP As Long
    Dim lngT As Long
    Dim lngK As Long
    Dim intP As Integer
On Error GoTo errSub
    lngK = GetTickCount    MoveToEx lngMemoryDC1, lngX, dblY, ByVal 0&
    
    lngX = lngX + 1
    dblY = (0.45 * H * Sin(K * lngX) + 0.5 * H)
    lngP = LineTo(lngMemoryDC1, lngX, dblY)
    
    
    If lngX <= L Then
        lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC1, 0, 0, SRCCOPY) '将内存位图中的图形拷贝到窗体上显示
    Else
        lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC1, lngX - L, 0, SRCAND) '将内存位图中的图形拷贝到窗体上显示
    End If
    Exit Sub
errSub:
End Sub

Answer 5

我要做一个画线的控件， 你上边的2个例子不行，  我要的是一个能加载的控件，不是picture.line 这样利用picture画线， 我要的这个控件有属性，记录端点坐标 ，记录和谁相连，而且能手动画线

Answer 6

   这是我用picture 实现的画线程序，但这些线没有属性， 我没法记录哪条线到哪个物体，例如， A线连 哪个控件的哪个端口等。线还要删除功能。 我其实要做的是个电路图，要识别哪个原件和哪个连接了Option Explicit
Private fx     As Single, fy       As Single
Private isDraw     As BooleanPrivate Sub Form_Load()
        Picture1.MousePointer = vbCrosshair
        Picture1.AutoRedraw = True
        isDraw = False
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        Select Case Button
                Case 1
                        If isDraw Then
                                Picture1.Refresh
                                Picture1.AutoRedraw = True
                                If Button = 1 Then Picture1.Line (fx, fy)-(x, y), vbBlack
                                fx = x:       fy = y
                        Else
                                Picture1.CurrentX = x:       Picture1.CurrentY = y
                                fx = x:       fy = y
                                isDraw = True
                        End If
                Case 2
                        isDraw = False
        End Select
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
        Picture1.AutoRedraw = False
        Picture1.Refresh
        If isDraw Then Picture1.Line (fx, fy)-(x, y), vbBlack
End Sub

Answer 7

那你就加载Line控件啊？现成的有，不必自己编写
而且可以编写一个界面设置Line控件的两端的坐标信息，颜色，线粗等属性

Answer 8

line 控件本身的功能太简单了， 不行，有自己的属性记录他的两端和哪个图形连接了， 坐标不行
，问题是line 控件我能象拿笔一样画线吗
你能告诉我一下QQ号码不， 加我一下，谢谢你了729127579， 交流方便