domingo, 21 de marzo de 2010

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





1 comentario:

Alex Lobo dijo...

Tan buenos los programas... veo que tendras un muy buen futuro si sigues asi