Sección de códigos , trucos y ejemplos para visual basic

178 - Obtener el ángulo en grados a partir de un punto

Este ejemplo está rescatado de un post hecho por algunos amigos del foro de canalvisualbasic con un pequeño aporte mío, y armé este ejemplo que consiste en obtener el valor en grados al mover al mouse a partir de un punto determinado, en este caso el punto está en el centro de la pantalla, y a medida que se mueve el puntero se imprime el valor:

vista del formulario de ejemplo

Colocar el código fuente en un formulario

Private Const PI As Single = 3.14159265358979 'Calcula en angulo entre dos puntos Public Function MATH_GetAngle( _ X1 As Single, _ Y1 As Single, _ X2 As Single, _ Y2 As Single) As Single MATH_GetAngle = CSng(MATH_Atan2(CDbl(Y2) - CDbl(Y1), _ CDbl(X2) - CDbl(X1)) * 180 / 3.14) End Function Private Sub Form_Load() BackColor = vbBlack ForeColor = vbGreen DrawWidth = 5 FontSize = 20 AutoRedraw = True DrawMode = 2 Caption = " Obtener el ángulo en grados a partir de un punto " End Sub Private Sub Form_MouseMove( _ Button As Integer, _ Shift As Integer, _ X As Single, _ Y As Single) Dim ret As Single ret = MATH_GetAngle(ScaleWidth / 2, Y, X, ScaleHeight / 2) If ret <= 0 Then A = Round(180 + (180 - (-ret))) Refresh Cls Else A = Round(ret) Refresh Cls End If CurrentX = X CurrentY = Y 'Dibuja el punto e imprime el valor en grados junto al puntero Me.Print " " & CStr(A) & " °" Me.Circle (ScaleWidth / 2, ScaleHeight / 2), 50 'Dibuja la línea horizontal y vertical Me.Line (ScaleWidth / 2, 0)-(ScaleWidth / 2, ScaleHeight) Me.Line (0, ScaleHeight / 2)-(ScaleWidth, ScaleHeight / 2) End Sub 'Función que Devuelve el arco tangente en radianes de dos números Public Function MATH_Atan2(X As Double, Y As Double) As Double On Error GoTo ErrOut Dim Theta As Double If (Abs(X) < 0.0000001) Then If (Abs(Y) < 0.0000001) Then Theta = 0# ElseIf (Y > 0#) Then Theta = 1.5707963267949 Else Theta = -1.5707963267949 End If Else Theta = Atn(Y / X) If (X < 0) Then If (Y >= 0#) Then Theta = 3.14159265358979 + Theta Else Theta = Theta - 3.14159265358979 End If End If End If MATH_Atan2 = Theta ErrOut: End Function

Buscar en Recursos vb