Administración de sistemas informáticos


Visual Basic


este es el metodo de biseccion en visual basic

se crean nueve etiquetas con caption i, xs, fxs, xi, fxi, xr, fxr, fifr y ea

se crean botones para evaluar en polinomio y en polinomio tambien para darle valor a cada variable cada uno con su respectivo cuadro de texto al lado par que el usuario pueda capturar los valores

Option Explicit

Dim sig As String

Dim b As String

Dim a As Double

Dim aux As Double

Dim xi As Double

Dim xs As Double

Dim xr As Double

Dim fxi As Double

Dim fxs As Double

Dim fxr As Double

Dim ff As Double

Dim ea As Double

Dim y As Double

Dim z As Double

Dim c As Double

Dim d As Double

Dim f As Double

Dim i As Double

Dim h As Double

Dim g As Double

Dim e As Double

Dim j As Double

Dim correcto As Integer

Private Sub cmdcalcular_Click()

fxi = y + z * xi + c * xi * Exp(2) + d * xi * Exp(3) + e * xi * Exp(4) + f * xi * Exp(5) + g * xi * Exp(6) + h * xi * Exp(7) + i * xi * Exp(8)

fxs = y + z * xs + c * xs * Exp(2) + d * xs * Exp(3) + e * xs * Exp(4) + f * xs * Exp(5) + g * xs * Exp(6) + h * xs * Exp(7) + i * xs * Exp(8)

xr = (xi + xs) / 2

fxr = y + z * xr + c * xr * Exp(2) + d * xr * Exp(3) + e * xr * Exp(4) + f * xr * Exp(5) + g * xr * Exp(6) + h * xr * Exp(7) + i * xr * Exp(8)

ff = fxi * fxr

Label2.Caption = Label2.Caption & vbCrLf & Format(xi, "0.#####")

Label4.Caption = Label4.Caption & vbCrLf & Format(xs, "0.#####")

If (ff > 0) Then

sig = "+"

xi = xr

ElseIf (ff < 0) Then

sig = "-"

xs = xr

End If

If (correcto > 0) Then

ea = Abs(((xr - a) / xr) * 100)

End If

Label1.Caption = Label1.Caption & vbCrLf & correcto

Label3.Caption = Label3.Caption & vbCrLf & Format(fxi, "0.#####")

Label5.Caption = Label5.Caption & vbCrLf & Format(fxs, "0.#####")

Label6.Caption = Label6.Caption & vbCrLf & Format(xr, "0.#####")

Label7.Caption = Label7.Caption & vbCrLf & Format(fxr, "0.#####")

Label8.Caption = Label8.Caption & vbCrLf & sig

Label9.Caption = Label9.Caption & vbCrLf & Format(ea, "0.####")

a = xr

If (ea < j) And (correcto > 0) Then

frmbiseccion.Visible = False

cmdcalcular.Enabled = False

frmprincipal.Visible = False

MsgBox "Raiz Encontrada en Xr=" & xr, vbExclamation, "MARIO Y ABRIL "

MsgBox "Con un erroR de ea=" & ea, vbInformation, "FUNCION POLINOMIO"

frmbiseccion.Visible = True

frmprincipal.Visible = True

End If

correcto = correcto + 1

End Sub

Private Sub cmdsalir_Click()

Unload Me

frmprincipal.Visible = True

End Sub

Private Sub Command1_Click()

Label1.Caption = " I"

Label2.Caption = " xi"

Label3.Caption = " f(xi)"

Label4.Caption = " xs"

Label5.Caption = " f(xs)"

Label6.Caption = " xr"

Label7.Caption = " f(xr)"

Label8.Caption = " f(xi) f(xr)"

Label9.Caption = " Ea %"

correcto = 0

cmdcalcular.Enabled = True

xi = 0

xs = 1

End Sub

Private Sub fmrj_Click()

j = txtj

End Sub

Private Sub Form_Load()

ea = 0

correcto = 0

frmprincipal.Visible = True

MsgBox "primero capture el numero en los espacios en blanco y despues oprima el respectivo boton", vbInformation

End Sub

Private Sub frmd_Click()

d = txtd

End Sub

Private Sub frme_Click()

e = txte

End Sub

Private Sub frmexp_Click()

fxi = (Exp(-xi)) - xi

fxs = (Exp(-xs)) - xs

xr = (xi + xs) / 2

fxr = (Exp(-xr)) - xr

ff = fxi * fxr

Label2.Caption = Label2.Caption & vbCrLf & Format(xi, "0.#####")

Label4.Caption = Label4.Caption & vbCrLf & Format(xs, "0.#####")

If (ff > 0) Then

sig = "+"

xi = xr

ElseIf (ff < 0) Then

sig = "-"

xs = xr

End If

If (correcto > 0) Then

ea = Abs(((xr - a) / xr) * 100)

End If

Label1.Caption = Label1.Caption & vbCrLf & correcto

Label3.Caption = Label3.Caption & vbCrLf & Format(fxi, "0.#####")

Label5.Caption = Label5.Caption & vbCrLf & Format(fxs, "0.#####")

Label6.Caption = Label6.Caption & vbCrLf & Format(xr, "0.#####")

Label7.Caption = Label7.Caption & vbCrLf & Format(fxr, "0.#####")

Label8.Caption = Label8.Caption & vbCrLf & sig

Label9.Caption = Label9.Caption & vbCrLf & Format(ea, "0.####")

a = xr

If (ea < 0.01) And (correcto > 0) Then

frmbiseccion.Visible = False

cmdcalcular.Enabled = False

frmprincipal.Visible = False

MsgBox "Raiz Encontrada en Xr=" & xr, vbExclamation, "MARIO Y ABRIL EXPONENCIAL "

MsgBox "y el error es=" & ea, vbInformation, "EXPONENCIAL"

frmbiseccion.Visible = True

End If

correcto = correcto + 1

End Sub

Private Sub frmf_Click()

f = txtf

End Sub

Private Sub frmg_Click()

g = txtg

End Sub

Private Sub frmh_Click()

h = txth

End Sub

Private Sub frmi_Click()

i = txti

End Sub

Private Sub frmxi_Click()

xi = txtxi

End Sub

Private Sub frmxs_Click()

xs = txtxs

End Sub

Private Sub vara_Click()

y = txta

End Sub

Private Sub varb_Click()

z = txtb

End Sub

Private Sub varc_clic()

c = txtc

End Sub




Descargar
Enviado por:Mayo
Idioma: castellano
País: México

Te va a interesar