tito
11 de Octubre del 2005

si alguno de ustedes tiene el codigo del metodo de GAUSS-JORDAN se los agradeceria si me lo mandaran
por favor

alex_j50
11 de Octubre del 2005

Public ing As String
Public ne As Integer
Private Sub Command2_Click()
resp = MsgBox("Esta seguro de " & vbCrLf & "borrar la matriz", vbInformation + vbYesNo + vbDefaultButton2, "Eliminaci贸n de Gauss")
If resp = 6 Then
answer.Clear
matrix.Clear
ing = 0
ing = InputBox("Ingrese el n煤mero de ecuaciones", "Eliminaci贸n de Gauss")
If ing = "" Then
txtingreso.SetFocus

Else
txtingreso.SetFocus
txtingreso.Text = Str(ing)
matrix.Cols = ing + 1
matrix.Rows = ing
Call tama帽o
End If
Else
Exit Sub
End If
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Activate()
txtingreso.SetFocus
End Sub
Private Sub Command1_Click()
ne = Val(txtingreso.Text)
answer.Rows = ne
' ne: es el n煤mero de ecuaciones
ReDim Sistema(1 To ne + 5, 1 To ne + 10) As Double
ReDim Soluci贸n(1 To ne) As Double
If matrix.Text = "" Then
MsgBox "Ingrese sus datos ", vbCritical + vbOKOnly, "Menzaje": Exit Sub
Else
For i = 1 To ne
For j = 1 To ne + 1
Sistema(i, j) = matrix.TextMatrix(i - 1, j - 1)
Next j
Next i
ReDim Soluci贸n(1 To ne) As Double
If Gauss(Sistema(), Soluci贸n()) Then
For i = 0 To ne - 1
answer.TextMatrix(i, 0) = Format(Soluci贸n(i + 1), "0.000")
Next i
Else
MsgBox "El sistema de ecuaciones no tiene soluci贸n...", vbCritical + vbOKOnly, "Atenci贸n"
End If
End If
tama帽o
End Sub

Private Sub Form_Load()
matrix.TextMatrix(0, 0) = 1
matrix.TextMatrix(0, 1) = 1
matrix.TextMatrix(0, 2) = 1
matrix.TextMatrix(0, 3) = 6
matrix.TextMatrix(1, 0) = 1
matrix.TextMatrix(1, 1) = 0
matrix.TextMatrix(1, 2) = 1
matrix.TextMatrix(1, 3) = 4
matrix.TextMatrix(2, 0) = 1
matrix.TextMatrix(2, 1) = 1
matrix.TextMatrix(2, 2) = 0
matrix.TextMatrix(2, 3) = 1
tama帽o
End Sub

Private Sub matrix_KeyPress(KeyAscii As Integer)
'NUMEROS DE 48-57
'. EL PUNTO "." 46
'LETRAS 65 -90
If KeyAscii >= 46 And KeyAscii <= 57 Then
matrix.Text = matrix.Text & Chr(KeyAscii)
End If
End Sub

Private Sub matrix_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDelete
matrix.Text = ""
Case vbKeyBack
If Len(matrix.Text) > 0 Then
matrix.Text = Left(matrix.Text, Len(matrix.Text) - 1)
End If
End Select
End Sub

Private Sub txtingreso_KeyPress(KeyAscii As Integer)
n = Val(txtingreso.Text)
ne = n
If KeyAscii = 13 Then
matrix.Cols = n + 1
matrix.Rows = n
tama帽o
End If

End Sub
Private Sub txtingreso_LostFocus()
n = Val(txtingreso.Text)
matrix.Cols = n + 1
matrix.Rows = n
End Sub
'Esta es una subrutina bajada de Internet
Static Function Gauss(ByRef A() As Double, ByRef C() As Double) As Boolean
Dim Tem As Double, Sum As Double, i, l, j, k, n, m
On Error GoTo Gauss_Err
n = UBound(C)
m = n + 1
For l = 1 To n - 1
j = l
For k = l + 1 To n
If (Abs(A(j, l)) >= Abs(A(k, l))) Then
Else: j = k
End If
Next
If Not (j = l) Then
For i = 1 To m
Tem = A(l, i)
A(l, i) = A(j, i)
A(j, i) = Tem
Next
End If
For j = l + 1 To n
Tem = A(j, l) / A(l, l)
For i = 1 To m
A(j, i) = A(j, i) - Tem * A(l, i)
Next
Next
Next
C(n) = A(n, m) / A(n, n)
For i = 1 To n - 1
j = n - i
Sum = 0
For l = 1 To i
k = j + l
Sum = Sum + A(j, k) * C(k)
Next
C(j) = (A(j, m) - Sum) / A(j, j)
Next
Gauss = True
Exit Function
Gauss_Err: Gauss = False
End Function
Sub tama帽o()
ne = Val(txtingreso.Text)
matrix.Height = matrix.RowHeight(1) * (ne + 0.5)
matrix.Width = (matrix.ColWidth(1)) * (ne + 1.12)
answer.Height = answer.RowHeight(1) * (ne + 0.5)
End Sub

'esta en visual solo tienes que poner los objetos....