se nesesitan
2 textBox (textbox 2 en propiedad multilinea = true)
1 CommandButton
Código
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String On Error GoTo 1 Dim a As Long Dim b As Long Dim CelVar() As Double If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) For a = 1 To nLineas For b = 1 To a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(3, " "), "") Next b If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf Next a 1: Erase CelVar End If End Function Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Text2.Text = GenerateTrianglePascal(Val(Text1.Text)) End Sub
con dowhile y doevents
Código
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function GenerateTrianglePascal(ByVal nLineas As Long) As String On Error GoTo 1 Dim a As Long Dim b As Long Dim CelVar() As Double If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) a = 1: Do While a <= nLineas b = 1: Do While b <= a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) GenerateTrianglePascal = GenerateTrianglePascal & CelVar(a, b) & IIf(Not b = a, String(2, " "), "") b = b + 1: Loop If a <> nLineas Then GenerateTrianglePascal = GenerateTrianglePascal & vbCrLf a = a + 1: Loop 1: Erase CelVar End If End Function Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Text2.Text = GenerateTrianglePascal(Val(Text1.Text)) End Sub
Código ligeramente mejorado ya se se queda tanto tiempo muerto!¡.
Código
' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Sub GenerateTrianglePascal(ByVal nLineas As Long, ByRef OutData As String) 'On Error GoTo 1 Dim a As Long Dim b As Long Dim Puntero As Long Dim Longitud As Long Dim Temporal As String Dim CelVar() As Double Dim OutDataTemp As String Const KiloByte As Long = 5120 If nLineas > 0 Then ReDim CelVar(nLineas, nLineas) Puntero = 1 OutDataTemp = Space(KiloByte) Temporal = Space(255) For a = 1 To nLineas For b = 1 To a: DoEvents CelVar(a, b) = Val(IIf(b = 1, 1, Val(CelVar(a - 1, b - 1)) + Val(CelVar(a - 1, b)))) Temporal = CelVar(a, b) & IIf(a <> b, " ", "") Longitud = Len(Temporal) Mid(OutDataTemp, Puntero, Longitud) = Temporal Puntero = Puntero + Longitud If Puntero > KiloByte Then OutData = OutData & OutDataTemp OutDataTemp = Space(KiloByte) Puntero = 2 End If Next b If a <> nLineas Then Puntero = Puntero Mid(OutDataTemp, Puntero, 2) = vbCrLf Puntero = Puntero + 2 End If Caption = a Next a 1: Erase CelVar End If OutData = OutData & Trim$(OutDataTemp) End Sub Private Sub Form_Load() Text2.Alignment = 2 ' // Modo centralizado End Sub Private Sub Command1_Click() Dim datas As String Call GenerateTrianglePascal(Val(Text1.Text), datas) Text2.Text = datas End Sub
la longitud de los números esta limitada por el buffer que solo le asigne 255 caracteres.
El limite de lineas es de 932 si es que no se aumentan los buffers de memoria
P.D.: El código en lugar de hacerle un redim a celvar(x,x) puede hacerse de esta forma Celver(1,x) pero decidí dejar los registros anteriores por si alguien deseaba hacerles cambios aun que de esta forma en la que lo deje gasta mas memoria ram en el modo celvar(1,x) no gastaría tanta pero tendría que estarse usando copymemori (API) para mover el de 1 a 0 y sacar los nuevos valores.
Dulces Lunas!¡