当前位置:编程学习 > VB >>

如何用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


核心函数:


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
--------------------编程问答-------------------- 实际上我也是用不同象限条件来取得绝对角(有9个象限条件),然后通过绝对角来取得相对角。只不过我没有用那么多判断语句而已。 --------------------编程问答-------------------- 顶小仙妹,哈哈!! --------------------编程问答-------------------- 下面是最新代码,彻底消灭了IF语句。(用AngleOffsetValue代替AngleAbsValue函数)
大量的判断分支会使一些条件很多的程序冗长不堪。根据我的经验:如果你不得不用大篇幅的If Then或者Select去写代码,一般来说是你方法错了。绝大多数If Then和Select都可以用更简洁的办法代替。但是这些替代方法理解起来有点困难。


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
--------------------编程问答-------------------- 学习 --------------------编程问答-------------------- AngleGetByPoint函数的最终简化形式。


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
--------------------编程问答--------------------
引用 8 楼 kitegirl 的回复:
AngleGetByPoint函数的最终简化形式。

VB codePublicFunction AngleGetByPoint(ByRef pSurXAsDouble, ByRef pSurYAsDouble, ByRef pDesXAsDouble, ByRef pDesYAsDouble)AsDouble'AngleGetByPoint函数'格式:    [tOutAngle] = AngleGetByPoint(pSurX, pSurY, pDesX, pDesY)'功能:    取得源点与目的点的角度'参数:    pSurX       double  源点X坐标'         pSurY       double  源点Y坐标'         pDesX       double  目的点Y坐标'         pDesY       double  目的点Y坐标'返回:    tOutAngle   double  目的点相对于源点的角度,范围0-359。Dim tOutAngleAsDoubleDim tOffsetX(1)AsDouble, tOffsetY(1)AsDoubleDim tQuad_CodeAsByte, tQuad_Code_NoExtAsByte, tQuad_Code_IndexAsByteDim tAngle_OffsetAsInteger, tAngle_Offset_List()AsByteDim tAngle_MultiAsInteger, tAngle_Multi_List()AsByteDim tAngle_Sur(1)AsDouble
  
  tOffsetY(0)=1: tOffsetX(1)= pSurX- pDesX: tOffsetY(1)= pSurY- pDesY'象限编码器  tQuad_Code= (CBool(tOffsetX(1))And8)Or (CBool(tOffsetY(1))And4)Or ((tOffsetX(1)>0)And2)Or ((tOffsetY(1)>0)And1)
  tQuad_Code_NoExt= ((tQuad_CodeAnd12)=12)And1
  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= tOutAngleEnd Function


我是来学习的,你做好了好几个版本阿 --------------------编程问答-------------------- 来学习 .. --------------------编程问答--------------------
引用 9 楼 clear_zero 的回复:
我是来学习的,你做好了好几个版本阿




3楼的:“原型”。

6楼的:把“原型”的判断语句逻辑化之后的改进型。

8楼的:取消为阅读方便设计的多余步骤,得到AngleGetByPoint函数的精简型。

把6楼的AngleOffsetValue函数和8楼的AngleGetByPoint函数放在一起就是最新版代码。
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,