1 0 0 0 0
1 1 0 0 0
1 2 1 0 0 
1 3 3 1 0
1 4 6 4 1

Matriz(x,y) = Matriz(x-1,y) + Martiz(x-1,y-1)

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
 
Rem Insertar TextBox con la propiedad Multiline = True y ScrollBars = Both
 
Option Explicit
 
Public Sub Generate_Pascal_Triangle(ByVal tTextBox As TextBox, ByVal iPotency As Integer)
    '//Declaro variables
    Dim lNumbersArray()          As Double
    Dim dNumber                  As Double
    Dim x                        As Long
    Dim y                        As Long
 
    '//Si la Potencia es menor a 3 sale del procedimiento
    If iPotency > 2 Then
        '//Redimensiono mi matriz con tantas filas y columnas como me indique la potencia
        ReDim lNumbersArray(iPotency, iPotency)
 
        '//Edito la primera linea de mi matriz puesto que la necesito como base
        lNumbersArray(1, 1) = 1
        For x = 2 To iPotency
            lNumbersArray(x, 1) = 0
        Next
 
        For x = 2 To iPotency
            For y = 1 To iPotency
                '//Si estoy en la primera columna no podria sumar otro elemento de mi matriz que
                'este más a la izquierda, si ocurre eso asigo a mi variable dNumber el valor 0
                If (y - 1) < 1 Then
                    dNumber = 0
                Else
                    dNumber = lNumbersArray(x - 1, y - 1)
                End If
                '//Utilizo la fórmula que puse antes
                lNumbersArray(x, y) = dNumber + lNumbersArray(x - 1, y)
            Next
        Next
 
        With tTextBox
            .Text = vbNullString    '//Limpio el TextBox
            .Alignment = 2          '//Pongo el texto centrado para que se aprecie mejor la piramide
            For x = 1 To iPotency
                For y = 1 To iPotency
                    '//Represento la matriz ya editada prescindiendo de los ceros
                    If lNumbersArray(x, y) <> 0 Then .Text = .Text & lNumbersArray(x, y) & Chr$(32)
                Next
                '//Nueva linea despues de acabar una fila
                .Text = .Text & vbCrLf
            Next
        End With
        '//Borro mi matriz
        Erase lNumbersArray '//Esto es prescindible ;)
    End If
End Sub

Private Sub Form_Load()
    Call Generate_Pascal_Triangle(Text1, 10)
End Sub

1 
1 1 
1 2 1 
1 3 3 1 
1 4 6 4 1 
1 5 10 10 5 1 
1 6 15 20 15 6 1 
1 7 21 35 35 21 7 1 
1 8 28 56 70 56 28 8 1 
1 9 36 84 126 126 84 36 9 1

Dim cadena As String
Cadena = "estoy cansado"
Cadena = Replace(Cadena, "e", "")

 
Option Explicit
 
Dim Rec As String, Aut As String
Dim Aviso As Boolean
Dim Fso As Object
 
Private Sub Command1_Click()
    On Error Resume Next
    With Fso
        If Not .DriveExists Then MsgBox "La unidad no está disponible", vbCritical, "USB Vaccination": Exit Sub
        Rec = Drive1.Drive & "\RECYCLER"
        Aut = Drive1.Drive & "\autorun.inf"
        If .FileExists(Aut) Then .DeleteFile Aut: MsgBox "Archivo sospechoso : " & Aut, vbCritical, "USB Vaccination"
        If .FolderExists(Rec) Then .DeleteFile Rec: MsgBox "Carpeta sospechosa : " & Rec, vbCritical, "USB Vaccination"
        If Not .FolderExists(Aut) Then
            .CreateFolder Aut: SetAttr Aut, vbHidden: SetAttr Aut, vbReadOnly
            MsgBox "Se creara carpeta " & Aut
        Else
            Aviso = True
        End If
        If Not .FileExists(Rec) Then
            Open Rec For Output As #1: Close: SetAttr Rec, vbHidden: SetAttr Rec, vbReadOnly
            MsgBox "Se creara archivo " & Rec
        Else
            Aviso = True
        End If
    End With
    If Aviso Then
        MsgBox "El USB " & Drive1.Drive & " ya estaba vacunado", vbCritical, "USB Vaccination"
    Else
        MsgBox "El USB " & Drive1.Drive & " se ha vacunado con éxito", vbInformation, "USB Vaccination"
    End If
End Sub
 
Private Sub Form_Load()
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Me.Caption =  "USB Vaccination"
    Command1.Caption = "Vacunar"
End Sub

' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* (miguelin.majo@gmail.com)                 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se  //
' // respete la autoria y se me comuniquen esos cambios.        //
' // *Agradecimientos a BlackZeroX.                             //
' // *Visita http://foro.rthacker.net                           //
' ////////////////////////////////////////////////////////////////
 
'\\Variables
Dim R1 As Integer, R2 As Integer, R3 As Integer, R4 As Integer
Dim C1 As Integer, C2 As Integer, C3 As Integer
Dim L As Integer
Dim Relleno As Boolean
Dim Que As Variant
 
Private Sub Form_Load()
    ' Pongo titulo al Form
    Me.Caption = "*PsYkE1* - Garabatos"
    ' Asigno el caption a cada botón
    Command1(0).Caption = "Parar"
    Command1(1).Caption = "Rellenos"
    Command1(2).Caption = "Salir"
End Sub
 
Private Sub HScroll1_Scroll()
    ' El intervalo del Timer sea igual a el Value del ScrollBar
    Timer1.Interval = HScroll1.Value
    ' El Value del ScrollBar me aparezca en el Label1
    Label1.Caption = HScroll1.Value
End Sub
 
Private Sub Command1_Click(Index As Integer)
    'Segun el Index asigno unos comandos a cada botón
    Select Case Index
        '\\Parar
        Case 0
            ' Limpio el Form
            Me.Cls
            ' Depende del Caption hace una cosa u otra
            If Command1(0).Caption = "Parar" Then
                MsgBox "Se han quitado los garabatos de tu Formulario", vbInformation, "*PsYkE1* - Garabatos"
                Timer1.Enabled = False
                Command1(0).Caption = "Comenzar"
            Else
                Timer1.Enabled = True
                Command1(0).Caption = "Parar"
            End If
        '\\Rellenos
        Case 1
            ' Limpio el Form
            Me.Cls
            Timer1.Enabled = True
            Command1(0).Caption = "Parar"
            ' Depende del Caption hace una cosa u otra
            If Command1(1).Caption = "Rellenos" Then
                Relleno = True
                MsgBox "Ahora se hará con rectangulos opacos", vbInformation, "*PsYkE1* - Garabatos"
                Command1(1).Caption = "Huecos"
            Else
                Relleno = False
                MsgBox "Se han quitado los garabatos de tu Formulario", vbInformation, "*PsYkE1* - Garabatos"
                Command1(1).Caption = "Rellenos"
            End If
        '\\Salir
        Case 2
            ' Si el Timer esta activado pregunta si quieres salir
            If Timer1.Enabled = True Then
                Que = MsgBox("¿Deseas salir?", vbQuestion + vbYesNo, "*PsYkE1* - Garabatos")
                ' Si dices SI sales del programa
                If Que = vbYes Then End
            End If
        End Select
 
End Sub
 
Private Sub Timer1_Timer() ' Cada 5 milisegundos
 
' Etiqueta Rndm
Rndm:
 
    ' Para que me salgan números aleatorios
    Randomize
 
    With Me ' Con el formulario actual
        ' Coordenada x del punto de partida
        ' dentro del alto del Form
        R1 = Int(Rnd * .Height)
        ' Coordenada y del punto de partida
        ' dentro del alto del Form
        R2 = Int(Rnd * .Height)
        ' Coordenada x del punto final
        ' dentro del ancho del Form
        R3 = Int(Rnd * .Width)
        ' Coordenada y del punto final
        ' dentro del ancho del Form
        R4 = Int(Rnd * .Width)
    End With
 
    ' Si las coordenadas de partida coinciden con las finales voy a la etiqueta Rndm
    If R1 = R3 And R2 = R4 Then GoTo Rndm
 
    ' Tres números aleatorios para definir el color de nuestra futura linea
    C1 = Int(Rnd * 255)
    C2 = Int(Rnd * 255)
    C3 = Int(Rnd * 255)
 
    If Relleno = False Then
        L = Int(Rnd * 3 + 1)
        If L = 1 Then
            Line (R1, R2)-(R3, R4), RGB(C1, C2, C3) ' Lineas
        ElseIf L = 2 Then
            Circle (R1, R2), (R3), RGB(C1, C2, C3) ' Circulos
        Else
            Line (R1, R2)-(R3, R4), RGB(C1, C2, C3), B ' Rectándulos
        End If
    Else
        Line (R1, R2)-(R3, R4), RGB(C1, C2, C3), BF ' Rectangulos rellenos
    End If
 
End Sub