Hola, aqui os dejo mi último proyecto:

PsYkE1 Crazy Desktop

*Podras hacer cosas como estas:


*¿Qué es PCD?
Es un programa con el cual podras pintar circulos de colores aleatorios en tu escritorio.

*¿Cómo funciona?
Descargalo y compruebalo  

*¿Para que sirve?
Echa a volar tu imaginación...

Bueno, espero que seais críticos, y me deis vuestra opinión, cualquier sugerencia sera tomada en cuenta...

Descargalo en http://www.mediafire.com/?xyzyydjyozz

Salu2!

by*PsYkE1*

Hola a todos, tras darle muchas vueltas he conseguido hacer un Triangulo de Pascal desde VB6.
Para que veais que no es un C&P os dire como llegue a la conclusion y os explicare cada paso que doy en los comentarios que aparecen en el code.

Deduccion:

Sabia que habia que resolverlo con una matriz, asi que hice una de 5x5 introduciendo los números que me deberian salir, algo asi:


Bien, una vez aqui pense cual era la logica de los numeros una vez dentro de la matriz...
Llegue a la conclusion de que todo elemento viene dado de la suma del que tiene encima con el de la izquierda del que tiene encima (que mal me explico)...
Unos ejemplos:
*El numero 4 sale de la suma del que tiene envima ( el 1) y el de la izquierda al que tiene encima (el 3)
*El numero 2 sale de la suma del que tiene envima ( el 1) y el de la izquierda al que tiene encima (otro 1)

Una vez aqui, os resultara muy facil entender la siguiente formula:


Me dejo de rodeos y os dejo el code:

' ////////////////////////////////////////////////////////////////
' // *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

Un ejemplito:

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

Obtenriamos este resultado en el TextBox:

Esto es todo, espero que os sirva... 
Espero el siguiente reto

Salu2! 

Hola, necesito vuestra ayda para una duda muy simple...
Tengo que quitar el caracter "e" de una cadena, para ello actualmente hago esto:

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

Queria saber si hay otra forma de hacerlo...

Gracias!

Hola a todos, os cuento mi problema a ver s sois capaces de ayudarme:
Toco la guitarra y dentro de un mes voy a dar mi primer concierto...
El problema es que tengo pánico escénico, y no se que hacer, porque cuando estoy nervioso toco FATAL...

Gracias!

Hola a todos, os explico y más que nada os pido opinion y consejo...
Haciendo pruebas me di cuenta que no puede haber un archivo y una carpeta con el mismo nombre, a raiz de eso se me ocurrio esto:

 
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

No se si es una tonteria y no vale para nada, solo se me ocurrio la idea...
Lo llevo usando un tiempo con mi lapiz metiendolo en ordenadores que se que estan infectados y el resultado ha sido bastante bueno... :smiley

Salu2!

Pues eso:

¿Cuantas horas dormis al dia?

PD: Yo 4...

Necesito varios sonidos .WAV de cristales rotos...
¿Me podeis ayudar?

Gracias!

Hola, necesito varias imagenes de un cristales rotos pero con el fondo transparente, ¿se entiende?...
He estado buscando y no he encontrado nada, tambien me valdria de unos balazos sobre cristal, tambien con el fondo transparente para poder aplicarlo a cualquier textura... 

PD: Adelanto que no tengo ni idea de retoque fotografico...

Gracias! 

Hola, AMO el ajedrez y llevo años jugando, me gustaria retaros a ver quien es capaz de ganarme...
Vosotros elegis la Web que querais y me retais por MP.

Gracias, os estoy esperando...

Hola buenas, aqui os presento mi ultimo invento :
Hacer garabatos de colores en tu formulario, es simple, pero me gusta el efecto...
Al cabo de unos seg tendriamos algo asi:


o así:
 

Bueno aqui va el codigo, es la cosa mas estupida que podais imaginar:
Necesitamos añadir:

* Un Timer
* Un ScrollBar
* Tres CommandButton (con una matriz)
* Un Label

' ////////////////////////////////////////////////////////////////
' // *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

Descargalo en http://www.mediafire.com/?yymmaefy1ey

Espero que os haya gustado...  

Salu2!