Programa que resuelve una ecuacion de grado 2

Este programa lo hice en visual basic 6.0, resuelve una ecuacion de grado 2 usando la formula cuadratica, acontinuacion les dejo el codigo fuente y el link para q bajen el instalador.

 

'codificado por Daniel Jiménez Martínez                                                III BTC “1”       

Dim a, b, c As Double

Dim x1, x2, p1, p2, p3, p4, p5, p6, p7, z1, z2, r1, r2, w1, w2, t1, t2 As Double

Private Sub cmdlimpiar_Click() ' Limpia los textbox

  txta.Text = " "

  txtb.Text = " "

  txtc.Text = " "

End Sub

Private Sub cmdresolver_Click()

   ' si los textbox estan vacios manda un mensaje diciendo que inserte numero en las casillas

   If ((Len(Trim(txta.Text)) = 0) And (Len(Trim(txtb.Text)) = 0) And (Len(Trim(txtc.Text)) = 0)) Then

     MsgBox "Introdusca valor a, b, c", vbExclamation, "ERROR"

     txta.SetFocus

     GoTo noo

     'si los textboxs de "b" y "c" estan vacias manda mensaje diciendo que inserte numeros en las casillas "b" y "c"

  ElseIf ((Len(Trim(txtb.Text)) = 0) And (Len(Trim(txtc.Text)) = 0)) Then

    MsgBox "Introdusca valor b, c", vbExclamation, "ERROR"

    txtb.SetFocus

 End If

 On Error GoTo noo

   ' guarda los valores de los textboxs en variables

 a = Val(txta.Text)

 b = Val(txtb.Text)

 c = Val(txtc.Text)

 

 If a = 0 Then ' si en la casilla se inserta cero manda un mensaje diciendo que en casilla a no puede insertar cero

   MsgBox "El valor de ""a"" no puede ser 0 ingrese otro numero", vbExclamation, "ERROR"

   txta.Text = " "

   txta.SetFocus

 End If

 p1 = ((b * b) - (4 * a * c))   'Saca la discriminante

  If (p1 < 0) Then 'No tiene solucion

    MsgBox "La ecuacion " & a & "X^2 + " & b & "X + " & c & " no tiene solucion", vbExclamation, "ERROR"

  ElseIf (p1 = 0) Then   ' Tiene una solucion

    p2 = 2 * a

    p3 = -1 * b

    p4 = p3 Mod p2

    If (p4 = 0) Then   ' verifica si la respuesta es un entero

      x1 = p3 / p2

      MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X: " & x1, vbInformation, "RESPUESTA"

   Else

     ' simplificacion de fracciones

     Dim q As Integer

     For q = 9 To 1 Step -1

       z1 = p3 Mod q

       z2 = p2 Mod q

       If ((z1 = 0) And (z2 = 0)) Then

         w1 = p3 / q

         w2 = p2 / q

         Exit For

       End If

     Next

     MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X: " & w1 & "/" & w2, vbInformation,      "RESPUESTA"

   End If

 

ElseIf (p1 > 0) Then ' Tiene dos soluciones

   p2 = Sqr(p1) ' elimina la raiz

   p3 = 2 * a

   p4 = (-1 * b) + p2

   p5 = (-1 * b) - p2

   p6 = p4 Mod p3

   p7 = p5 Mod p3

   If ((p6 = 0) And (p7 = 0)) Then ' verifica si las dos soluciones son enteros

     x1 = p4 / p3

     x2 = p5 / p3

     MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X1: " & x1 & "  X2: " & x2, vbInformation, "RESPUESTA"

   ElseIf ((p6 = 0) And (p7 <> 0)) Then ' una solucion es fraccion y otra entero

    x1 = p4 / p3

     fracminx2  ' llama a funcion que reduce fracciones

     MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X1: " & x1 & "  X2: " & t1 & "/" & t2, vbInformation, "RESPUESTA"

   ElseIf ((p6 <> 0) And (p7 = 0)) Then ' una solucion es fraccion y otra entero

     x2 = p5 / p3

     fracminx1  ' llama a funcion que reduce fracciones

     MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X1:  " & w1 & "/" & w2 & "  X2: " & x2, vbInformation, "RESPUESTA"

   Else ' ambas respuestas son fracciones

     fracminx1  ' llama a funcion que reduce fracciones

     fracminx2  ' llama a funcion que reduce fracciones

     MsgBox "La solucion a la ecuacion " & a & "X^2 + " & b & "X + " & c & " es X1: " & w1 & "/" & w2 & "  X2:   If"

   End If

 End If

noo:

End Sub

Private Sub mnu_acerca_Click()

frmAbout.Show

End Sub

Private Sub mnu_salir_Click()

 End

End Sub

Sub fracminx1() ' simplifica fracciones

Dim g As Integer

 For g = 9 To 1 Step -1

  z1 = p4 Mod g

  z2 = p3 Mod g

  If ((z1 = 0) And (z2 = 0)) Then

   w1 = p4 / g

   w2 = p3 / g

   Exit For

  End If

 Next

End Sub

Sub fracminx2() 'simplifica fracciones

 Dim f As Integer

   For f = 9 To 1 Step -1

    r1 = p5 Mod f

    r2 = p3 Mod f

    If ((r1 = 0) And (r2 = 0)) Then

      t1 = p5 / f

      t2 = p3 / f

      Exit For

    End If

   Next

End Sub

Private Sub txta_KeyPress(KeyAscii As Integer) ' hace que el texbox "a" solo acepte numeros, punto y menos

  If InStr("-0123456789." & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then

    KeyAscii = 0

  End If

End Sub

Private Sub txtb_KeyPress(KeyAscii As Integer) ' hace que el texbox "b" solo acepte numeros, punto y menos

  If InStr("-0123456789." & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then

    KeyAscii = 0

  End If

End Sub

Private Sub txtc_KeyPress(KeyAscii As Integer) ' hace que el texbox "c" solo acepte numeros, punto y menos

  If InStr("-0123456789." & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then

    KeyAscii = 0

  End If

End Sub

Descargar