紧急求助!如何在控件中画一条带箭头的直线?
我现在做的东东需要在两个可以自由拖动的控件之间画一条带箭头的直线,要求是当控件的位置发生变化时,连线的位置也得跟着变化。
程序说明:
可以自由拖动的控件是放在一个PictureBox中,已经实现PictureBox大小的自动变化和控件位置的自由拖动。
对于连接线,我现在的想法是做一个背景透明的控件,在控件上画一条直线并在直线的一个端点位置画一个小三角形;要求画线的控件在连接线变化时也能相应的作出变化,以实现完整的显示连接线。
问题:
1、我用API函数画的三角形,为什么不能立即在控件上显示出来。我在测试时发现,当画图后改变IE浏览器窗口大小时就可以显示三角形,原因是什么呢?我已经将控件的AutoRedraw设置为True了。
2、当连线的方向发生变化时,需要重画小三角形,我应该怎么做才能清掉原来的三角形?我发现调用控件的cls方法后,新画的三角形确没有显示出来。
3、我的这种做法对作为容器的PictureBox 中的其它控件会不会有不良的影响?
欢迎大家讨论,如果觉得分不够可以再加!@_@!
问题点数:100、回复次数:4Top
1 楼IceSheet()回复于 2002-05-30 01:49:24 得分 0
画三角行的测试代码(在ActiveX控件中):
Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Public mvarPointArr(2) As POINTAPI
Private mvarx As Single
Private mvary As Single
Private Sub Command1_Click()
mvarPointArr(0).x = 100 + mvarx
mvarPointArr(0).y = 150 + mvary
mvarPointArr(1).x = mvarPointArr(0).x + 10
mvarPointArr(1).y = mvarPointArr(0).y + 10
mvarPointArr(2).x = mvarPointArr(0).x - 10
mvarPointArr(2).y = mvarPointArr(0).y + 10
Call Polygon(hdc, mvarPointArr(0), 3)
mvarx = mvarx + 1
mvary = mvary - 1
End Sub
Private Sub Command2_Click()
Cls
End Sub
Top
2 楼IceSheet()回复于 2002-05-30 01:55:07 得分 0
在测试时改变IE的大小还能看到三角形,在一个新的工程里使用时则怎么都看不到???Top
3 楼gxingmin(小高)回复于 2002-05-30 08:16:03 得分 100
用户控件LineArrow,属性:BackColor=&H80000000&
代码如下:
Const m_def_BegX = 0
Const m_def_BegY = 0
Const m_def_EndX = 0
Const m_def_EndY = 0
Const PI = 3.1415926
Dim m_BegX As Single
Dim m_BegY As Single
Dim m_EndX As Single
Dim m_EndY As Single
Dim LineAngle As Double
Dim OldLineAngle As Double
'Dim rc As RECT
Dim X1 As Single, X2 As SingleEvent XYChanged()
Event Show() 'MappingInfo=UserControl,UserControl,-1,Show
Private Sub UserControl_InitProperties()
m_BegX = m_def_BegX
m_BegY = m_def_BegY
m_EndX = m_def_EndX
m_EndY = m_def_EndY
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_BegX = PropBag.ReadProperty("BegX", m_def_BegX)
m_BegY = PropBag.ReadProperty("BegY", m_def_BegY)
m_EndX = PropBag.ReadProperty("EndX", m_def_EndX)
m_EndY = PropBag.ReadProperty("EndY", m_def_EndY)
UserControl.DrawMode = PropBag.ReadProperty("DrawMode", 7)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BegX", m_BegX, m_def_BegX)
Call PropBag.WriteProperty("BegY", m_BegY, m_def_BegY)
Call PropBag.WriteProperty("EndX", m_EndX, m_def_EndX)
Call PropBag.WriteProperty("EndY", m_EndY, m_def_EndY)
Call PropBag.WriteProperty("DrawMode", UserControl.DrawMode, 7)
End Sub
'MemberInfo=12,0,0,0
Public Property Get BegX() As Single
BegX = m_BegX
End Property
Public Property Let BegX(ByVal New_BegX As Single)
m_BegX = New_BegX
PropertyChanged "BegX"
End Property
'MemberInfo=12,0,0,0
Public Property Get BegY() As Single
BegY = m_BegY
End Property
Public Property Let BegY(ByVal New_BegY As Single)
m_BegY = New_BegY
PropertyChanged "BegY"
End Property
'MemberInfo=12,0,0,0
Public Property Get EndX() As Single
EndX = m_EndX
End Property
Public Property Let EndX(ByVal New_EndX As Single)
m_EndX = New_EndX
PropertyChanged "EndX"
End Property
'MemberInfo=12,0,0,0
Public Property Get EndY() As Single
EndY = m_EndY
End Property
Public Property Let EndY(ByVal New_EndY As Single)
m_EndY = New_EndY
PropertyChanged "EndY"
End Property
Private Sub UserControl_Show()
RaiseEvent Show
UserControl.Width = 200
UserControl.Height = 200
End Sub
Private Sub XYChanged()
RaiseEvent XYChanged
End Sub
Public Property Get DrawMode() As Integer
DrawMode = UserControl.DrawMode
End Property
Public Property Let DrawMode(ByVal New_DrawMode As Integer)
UserControl.DrawMode() = New_DrawMode
PropertyChanged "DrawMode"
End Property
Public Sub PaintAngle(BegX As Single, BegY As Single, EndX As Single, EndY As Single)
UserControl.DrawMode = vbCopyPen
UserControl.Cls
DrawWidth = 1
If EndX = BegX Then
If EndY > BegY Then
X1 = 100
Y1 = 200
LineAngle = PI / 2
Else
X1 = 100
Y1 = 0
LineAngle = PI * 3 / 2
End If
ElseIf EndX > BegX Then
LineAngle = PI - Atn((EndY - BegY) / (EndX - BegX))
If EndY > BegY Then
If (EndY - BegY) / (EndX - BegX) < 1 Then
X1 = 200
Y1 = 100 + 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 + 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 200
End If
Else
If (EndY - BegY) / (EndX - BegX) > -1 Then
X1 = 200
Y1 = 100 + 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 - 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 0
End If
End If
Else
LineAngle = 2 * PI - Atn((EndY - BegY) / (EndX - BegX))
If EndY > BegY Then
If (EndY - BegY) / (EndX - BegX) > -1 Then
X1 = 0
Y1 = 100 - 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 + 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 200
End If
Else
If (EndY - BegY) / (EndX - BegX) > 1 Then
X1 = 100 - 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 0
Else
X1 = 0
Y1 = 100 - 100 * (EndY - BegY) / (EndX - BegX)
End If
End If
End If
''''''''''''''''开始画扇形
If LineAngle + PI / 12 <= PI * 2 Then
Circle (X1, Y1), 200, &H80000012, -(LineAngle - PI / 12), -(LineAngle + PI / 12)
ElseIf LineAngle - PI / 12 >= PI * 2 Then
Circle (X1, Y1), 200, &H80000012, -(LineAngle - PI / 12 - PI * 2), -(LineAngle + PI / 12 - PI * 2)
Else 'LineAngle - PI / 12 < PI * 2 and LineAngle + PI / 12 > PI * 2
Circle (X1, Y1), 200, &H80000012, -(LineAngle - PI / 12), -(LineAngle + PI / 12 - PI * 2)
End If
End Sub
Form窗体上放一个LineArrow1和Line1
代码如下:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.X1 = X
Line1.Y1 = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.X2 = X
Line1.Y2 = Y
LineArrow1.Left = X - LineArrow1.Width / 2
LineArrow1.Top = Y - LineArrow1.Height / 2
LineArrow1.PaintAngle Line1.X1, Line1.Y1, Line1.X2, Line1.Y2
End Sub
Top
4 楼IceSheet()回复于 2002-05-30 09:24:14 得分 0
很好!
谢谢!Top




