Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Radici di numeri imaginari - Radici di numeri immaginari.frm

Radici di numeri immaginari.frm

Caricato da: Antometal
Scarica il programma completo

  1. Option Explicit
  2. Public RipristinoEsponente As String
  3. Public RipristinoReale As String
  4. Public RipristinoImmaginario As String
  5. Public XS As Integer
  6. Public YS As Integer
  7. Const Pi As Double = 3.141592653589
  8.  
  9. Private Function GPS(ByVal Gradi As Double) As String
  10. Dim G As Double
  11. Dim P As Double
  12. Dim S As Double
  13.     Do Until Gradi < 360
  14.         Gradi = Gradi - 360
  15.     Loop
  16. G = Int(Gradi)
  17. Gradi = (Gradi - G) * 100
  18. Gradi = Gradi * 3 / 5
  19. P = Int(Gradi)
  20. Gradi = (Gradi - P) * 100
  21. Gradi = Gradi * 3 / 5
  22. S = Int(Gradi)
  23. GPS = G & "° " & P & "' " & S & """"
  24. End Function
  25.  
  26. Private Sub Seleziona(Oggetto As TextBox)
  27. Oggetto.SelStart = 0
  28. Oggetto.SelLength = Len(Oggetto)
  29. Oggetto.SetFocus
  30. End Sub
  31.  
  32. Private Sub Controllo(Oggetto As TextBox, Ripristino As String)
  33. Dim I As Integer
  34. Oggetto = Val(Oggetto)
  35.     If Oggetto = 0 Then Seleziona Oggetto
  36.     For I = 1 To Len(Oggetto)
  37.             If (Asc(Mid(Oggetto, I, 1)) < 48 Or Asc(Mid(Oggetto, I, 1)) > 59) Or (Oggetto = 0 And Oggetto.TabIndex = 0) Then Oggetto.Text = Ripristino
  38.         Ripristino = Abs(Oggetto.Text)
  39.     Next I
  40. End Sub
  41.  
  42. Private Function Segno(Index As Integer) As Integer
  43.     If Index = 0 Then Segno = -1
  44.     If Index = 1 Then Segno = 1
  45. End Function
  46.  
  47. Private Sub CalcolaRadici(E As Integer, P As Double, Grado As Double)
  48. Dim A As Double
  49. Dim B As Double
  50. Dim X2 As Double
  51. Dim Y2 As Double
  52. Dim X1 As Double
  53. Dim Y1 As Double
  54. Y1 = Round(P * Sin(((Grado + 360 * W) / E) * Pi / 180), 3)
  55. X1 = Round(P * Cos(((Grado + 360 * W) / E) * Pi / 180), 3)
  56. lsRisultati.AddItem "W(" & W & ")=" & vbTab & P & " * cos " & GPS((Grado + 360 * W) / E) & " + " & P & " * sin " & GPS((Grado + 360 * W) / E) & vbTab & "=" & X1 & " + " & Y1 & "i"
  57. picGrafico.DrawWidth = 4
  58. picGrafico.PSet (X1, Y1), vbBlue
  59.     If W = 0 Then
  60.         A = X1
  61.         B = Y1
  62.     End If
  63. picGrafico.DrawWidth = 1
  64.     If W <> 0 Then picGrafico.Line (X1, Y1)-(X2, Y2), vbRed
  65.     If W = E - 1 Then picGrafico.Line (X1, Y1)-(A, B), vbRed
  66. X2 = X1
  67. Y2 = Y1
  68. End Sub
  69.  
  70. Private Sub cmdRisultato_Click()
  71. On Error GoTo Errore
  72. Dim E As Integer
  73. Dim P As Double
  74. Dim W As Integer
  75. Dim Grado As Double
  76. lsRisultati.Clear
  77. picGrafico.Refresh
  78.     If txtReale = 0 Or txtImmaginario = 0 Then
  79.             If txtReale = 0 And optSImmaginario(0).Value = True Then Grado = 270
  80.             If txtReale = 0 And optSImmaginario(1).Value = True Then Grado = 90
  81.             If txtImmaginario = 0 And optSReale(0).Value = True Then Grado = 180
  82.             If txtImmaginario = 0 And optSReale(1).Value = True Then Grado = 0
  83.     Else
  84.         Grado = Atn(YS * txtImmaginario / XS * txtReale) * 180 / Pi
  85.             If YS = -1 Then Grado = Grado + 180
  86.     End If
  87. E = txtEsponente
  88. P = Round(Sqr((txtReale) ^ 2 + (txtImmaginario) ^ 2), 3)
  89.     If P <> 0 Then
  90.         picGrafico.Scale (-P * 1.1, P * 1.1)-(P * 1.1, -P * 1.1)
  91.         picGrafico.Line (-P * 1.1, 0)-(P * 1.1, 0), vbBlack
  92.         picGrafico.Line (0, P * 1.1)-(0, -P * 1.1), vbBlack
  93.         picGrafico.DrawWidth = 4
  94.         picGrafico.PSet (XS * txtReale, YS * txtImmaginario), vbMagenta
  95.     End If
  96.    
  97.     For W = 0 To E - 1
  98.         CalcolaRadici E, P, Grado
  99.     Next W
  100.    
  101. Exit Sub
  102. Errore:
  103. MsgBox "Errore n. " & Err.Number & vbCrLf & Err.Description, vbCritical
  104. End Sub
  105.  
  106. Private Sub Form_Load()
  107. RipristinoEsponente = txtEsponente
  108. RipristinoReale = txtReale
  109. RipristinoImmaginario = txtImmaginario
  110. XS = 1
  111. YS = 1
  112. End Sub
  113.  
  114. Private Sub lsRisultati_Click()
  115.     For W = 0 To E
  116.         CalcolaRadici E, P, Grado
  117.     Next W
  118. CalcolaRadici(
  119. End Sub
  120.  
  121. Private Sub lsRisultati_DblClick()
  122. txtRisultato.Text = lsRisultati.List(lsRisultati.ListIndex)
  123. End Sub
  124.  
  125. Private Sub optSImmaginario_Click(Index As Integer)
  126. YS = Segno(Index)
  127. End Sub
  128.  
  129. Private Sub optSReale_Click(Index As Integer)
  130. XS = Segno(Index)
  131. End Sub
  132.  
  133. Private Sub picGrafico_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  134. lblCoordinate.Caption = "X " & X & " - Y " & Y
  135. End Sub
  136.  
  137. Private Sub txtEsponente_Change()
  138. Controllo txtEsponente, RipristinoEsponente
  139. End Sub
  140.  
  141. Private Sub txtEsponente_GotFocus()
  142. Seleziona txtEsponente
  143. End Sub
  144.  
  145. Private Sub txtImmaginario_Change()
  146. Controllo txtImmaginario, RipristinoImmaginario
  147. End Sub
  148.  
  149. Private Sub txtImmaginario_GotFocus()
  150. Seleziona txtImmaginario
  151. End Sub
  152.  
  153. Private Sub txtReale_Change()
  154. Controllo txtReale, RipristinoReale
  155. End Sub
  156.  
  157. Private Sub txtReale_GotFocus()
  158. Seleziona txtReale
  159. End Sub
  160.  
  161. Private Sub txtRisultato_Click()
  162. Clipboard.Clear
  163. Clipboard.SetText txtRisultato
  164. End Sub