如何用VB6做一个可以连续旋转数圈并记录转过角度的旋钮?
搜索以前的帖子,看见有人问过相同的问题,但是答案都是语焉不详,或者只有个初步想法,真正实现起来还是比较麻烦,所以还是硬着头皮提此一问。
现在要做的就是在VB的form中确定一个中心点,然后按下鼠标使光标绕着这个中心点不停的旋转。
可以一直是顺时针旋转,也可以一直是逆时针旋转,还可以在顺时针转的时候不放开鼠标换成逆时针旋转,
或者逆时针旋转的时候不放开鼠标换成顺时针旋转。
旋转不仅仅限于360度范围,理论上=也就是说可以连续旋转无限多的周数。
现在的要求就是要实时记录并显示这个鼠标转了多少刻度?
本人愚笨,想了好久,也只想到一个实在算不上聪明的办法,想问一下坛子里的高手有没有简单、方便、快捷的算法?
非常感谢。
--------------------编程问答-------------------- 本人的笨办法是通过区分不同的象限条件,实时判定旋转的方向,用一个定时的累积量不断更新转过的角度。
但个人觉得这实在不是个高明的算法(主要是因为VB6所带的反余切函数的定义域中有非零的要求,所以综合起来的各种象限条件非常多。)。所以发此一贴讨教。 --------------------编程问答-------------------- 帮顶顶.
--------------------编程问答-------------------- 测试代码:按住鼠标左键围绕圆圈旋转,角度会累计。
Private priAngleRec As Double
Private priAngleAdd As Double
Private Sub Form_Load()
'要让Picture1.ScaleMode = 3
Picture1.AutoRedraw = True
Picture1.Circle (150, 150), 10, RGB(0, 0, 0)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tAngle As Double
Dim tAngleAbs As Double
tAngle = AngleGetByPoint(150, 150, CLng(X), CLng(Y))
tAngleAbs = AngleAbsValue(priAngleRec, tAngle)
If Button = 1 Then priAngleAdd = priAngleAdd + tAngleAbs
Text1.Text = "累计角:" & priAngleAdd & " 相对角:" & tAngleAbs
priAngleRec = tAngle
End Sub
核心函数:
--------------------编程问答-------------------- 实际上我也是用不同象限条件来取得绝对角(有9个象限条件),然后通过绝对角来取得相对角。只不过我没有用那么多判断语句而已。 --------------------编程问答-------------------- 顶小仙妹,哈哈!! --------------------编程问答-------------------- 下面是最新代码,彻底消灭了IF语句。(用AngleOffsetValue代替AngleAbsValue函数)
Public Function AngleAbsValue(ByRef pAngleSur As Double, ByRef pAngleDes As Double) As Double
'计算两个角的相对值
Dim tOutAngle As Double
Dim tAngleAbs As Double
tAngleAbs = pAngleDes - pAngleSur
If tAngleAbs > 270 Then
tOutAngle = tAngleAbs - 360
ElseIf tAngleAbs < -270 Then
tOutAngle = tAngleAbs + 360
Else
tOutAngle = tAngleAbs
End If
AngleAbsValue = tOutAngle
End Function
Public Function AngleGetByPoint(ByRef pBaseX As Long, ByRef pBaseY As Long, ByRef pAbsX As Long, ByRef pAbsY As Long) As Double
'取两点的相对角度
Dim tOutAngle As Double
Dim tQuad_DeCoder() As Byte
Dim tAngle_Base As Double
Dim tQuad As Byte
Dim tQuad_Sur As Byte
Dim tQuad_ExtX As Byte
Dim tQuad_ExtY As Byte
Dim tQuad_X As Byte
Dim tQuad_Y As Byte
Dim tQuad_Ext As Boolean
Dim tOffsetX As Long
Dim tOffsetY As Long
Dim tAngle_Offset_List() As Byte
Dim tAngle_Offset As Long
Dim tAngle_Multi_List() As Byte
Dim tAngle_Multi As Long
Dim tAngle_Sur As Double
tOffsetX = pBaseX - pAbsX
tOffsetY = pBaseY - pAbsY
'象限编码器
tQuad_ExtX = CBool(tOffsetX) And 8: tQuad_X = (tOffsetX > 0) And 2
tQuad_ExtY = CBool(tOffsetY) And 4: tQuad_Y = (tOffsetY > 0) And 1
tQuad_Sur = tQuad_ExtX Or tQuad_ExtY Or tQuad_X Or tQuad_Y
ReDim tAQ_Multi(0 To 15)
ReDim tAQ_Offset(0 To 15)
'象限解码器
tQuad_DeCoder() = "0000510030704268"
tQuad = tQuad_DeCoder(tQuad_Sur * 2) - 48
tQuad_Ext = (tQuad_Sur And 12) = 12
'象限角解码器
tAngle_Offset_List() = "4445666784444444"
tAngle_Offset = ((tAngle_Offset_List(tQuad * 2) - 48) - 4) * 90
'角符号解码器
tAngle_Multi_List() = "1101010101111111"
tAngle_Multi = (tAngle_Multi_List(tQuad * 2) - 48) - 1
If tQuad_Ext Then
tAngle_Sur = Atn(tOffsetX / tOffsetY) * 180 / 3.14159265358979
End If
tOutAngle = tAngle_Sur * tAngle_Multi + tAngle_Offset
AngleGetByPoint = tOutAngle
End Function
大量的判断分支会使一些条件很多的程序冗长不堪。根据我的经验:如果你不得不用大篇幅的If Then或者Select去写代码,一般来说是你方法错了。绝大多数If Then和Select都可以用更简洁的办法代替。但是这些替代方法理解起来有点困难。
--------------------编程问答-------------------- 学习 --------------------编程问答-------------------- AngleGetByPoint函数的最终简化形式。
Public Function AngleOffsetValue(ByRef pAngleSur As Double, ByRef pAngleDes As Double) As Double
'AngleOffsetValue函数
'格式: [tOutAngle] = AngleOffsetValue(pAngleSur, pAngleDes)
'功能: 取得源点与目的点的角度
'参数: pAngleSur double 源角
' pAngleDes double 目的角
'返回: tOutAngle double 目的角相对于源角的角度,范围0-90。
Dim tOutAngle As Double
Dim tAngleAbs As Double
Dim tAngleAdd As Integer
tAngleAbs = pAngleDes - pAngleSur
tAngleAdd = (((tAngleAbs > 270) And -360) Or ((tAngleAbs < -270) And 360))
tOutAngle = tAngleAbs + tAngleAdd
AngleOffsetValue = tOutAngle
End Function
Public Function AngleGetByPoint(ByRef pSurX As Double, ByRef pSurY As Double, ByRef pDesX As Double, ByRef pDesY As Double) As Double
'AngleGetByPoint函数
'格式: [tOutAngle] = AngleGetByPoint(pSurX, pSurY, pDesX, pDesY)
'功能: 取得源点与目的点的角度
'参数: pSurX double 源点X坐标
' pSurY double 源点Y坐标
' pDesX double 目的点Y坐标
' pDesY double 目的点Y坐标
'返回: tOutAngle double 目的点相对于源点的角度,范围0-359。
Dim tOutAngle As Double
Dim tOffsetX(1) As Double, tOffsetY(1) As Double
Dim tQuad As Byte, tQuad_DeCoder() As Byte
Dim tQuad_Code As Byte
Dim tQuad_Code_ExtX As Byte, tQuad_Code_ExtY As Byte
Dim tQuad_Code_DirX As Byte, tQuad_Code_DirY As Byte
Dim tQuad_Code_NoExt As Byte
Dim tAngle_Offset As Integer, tAngle_Offset_List() As Byte
Dim tAngle_Multi As Integer, tAngle_Multi_List() As Byte
Dim tAngle_Sur(1) As Double
tOffsetY(0) = 1
tOffsetX(1) = pSurX - pDesX: tOffsetY(1) = pSurY - pDesY
'象限编码器
tQuad_Code_ExtX = CBool(tOffsetX(1)) And 8: tQuad_Code_DirX = (tOffsetX(1) > 0) And 2
tQuad_Code_ExtY = CBool(tOffsetY(1)) And 4: tQuad_Code_DirY = (tOffsetY(1) > 0) And 1
tQuad_Code = tQuad_Code_ExtX Or tQuad_Code_ExtY Or tQuad_Code_DirX Or tQuad_Code_DirY
tQuad_Code_NoExt = ((tQuad_Code And 12) = 12) And 1
'象限解码器
tQuad_DeCoder() = "0000510030704268"
tQuad = tQuad_DeCoder(tQuad_Code * 2) - 48
'角偏移解码器
tAngle_Offset_List() = "4445666784444444"
tAngle_Offset = ((tAngle_Offset_List(tQuad * 2) - 48) - 4) * 90
'角符号解码器
tAngle_Multi_List() = "1101010101111111"
tAngle_Multi = (tAngle_Multi_List(tQuad * 2) - 48) - 1
tAngle_Sur(1) = Atn(tOffsetX(tQuad_Code_NoExt) / tOffsetY(tQuad_Code_NoExt)) * 180 / 3.14159265358979
tOutAngle = tAngle_Sur(tQuad_Code_NoExt) * tAngle_Multi + tAngle_Offset
AngleGetByPoint = tOutAngle
End Function
--------------------编程问答--------------------
Public Function AngleGetByPoint(ByRef pSurX As Double, ByRef pSurY As Double, ByRef pDesX As Double, ByRef pDesY As Double) As Double
'AngleGetByPoint函数
'格式: [tOutAngle] = AngleGetByPoint(pSurX, pSurY, pDesX, pDesY)
'功能: 取得源点与目的点的角度
'参数: pSurX double 源点X坐标
' pSurY double 源点Y坐标
' pDesX double 目的点Y坐标
' pDesY double 目的点Y坐标
'返回: tOutAngle double 目的点相对于源点的角度,范围0-359。
Dim tOutAngle As Double
Dim tOffsetX(1) As Double, tOffsetY(1) As Double
Dim tQuad_Code As Byte, tQuad_Code_NoExt As Byte, tQuad_Code_Index As Byte
Dim tAngle_Offset As Integer, tAngle_Offset_List() As Byte
Dim tAngle_Multi As Integer, tAngle_Multi_List() As Byte
Dim tAngle_Sur(1) As Double
tOffsetY(0) = 1: tOffsetX(1) = pSurX - pDesX: tOffsetY(1) = pSurY - pDesY
'象限编码器
tQuad_Code = (CBool(tOffsetX(1)) And 8) Or (CBool(tOffsetY(1)) And 4) Or ((tOffsetX(1) > 0) And 2) Or ((tOffsetY(1) > 0) And 1)
tQuad_Code_NoExt = ((tQuad_Code And 12) = 12) And 1
tQuad_Code_Index = tQuad_Code * 2
'角偏移解码器
tAngle_Offset_List() = "4444644454746468"
tAngle_Offset = (tAngle_Offset_List(tQuad_Code_Index) - 52) * 90
'角符号解码器
tAngle_Multi_List() = "1111111111110000"
tAngle_Multi = (tAngle_Multi_List(tQuad_Code_Index) - 49)
tAngle_Sur(1) = Atn(tOffsetX(tQuad_Code_NoExt) / tOffsetY(tQuad_Code_NoExt)) * 57.2957795130823
tOutAngle = tAngle_Sur(tQuad_Code_NoExt) * tAngle_Multi + tAngle_Offset
AngleGetByPoint = tOutAngle
End Function
我是来学习的,你做好了好几个版本阿 --------------------编程问答-------------------- 来学习 .. --------------------编程问答--------------------
3楼的:“原型”。
6楼的:把“原型”的判断语句逻辑化之后的改进型。
8楼的:取消为阅读方便设计的多余步骤,得到AngleGetByPoint函数的精简型。
把6楼的AngleOffsetValue函数和8楼的AngleGetByPoint函数放在一起就是最新版代码。
补充:VB , 基础类