HOLA!!!

Te acabe de armar un pequeño ejemplo:
crea un form con un list view que se llame "LV" y pega el codigo:

Private Sub Form_Load()
    With lv
         .View = lvwReport
         .ColumnHeaders.Add , , "lo que sea"
         .GridLines = True
         .FullRowSelect = True
    End With
For x = 1 To 10
lv.ListItems.Add , , x
Next
lv.ListItems.Remove 3 ' elimina la posicion 3
lv.ListItems.Add 2, , "hola" 'pone entre la posicion 1 y 2 la palabra hola
Dim aux As String 'variable auxiliar
'intercambia la posicion 6 por la 9 
aux = lv.ListItems.Item(9)
lv.ListItems.Item(9) = lv.ListItems.Item(6)
lv.ListItems.Item(6) = aux
End Sub
 

GRACIAS POR LEER!!!

HOLA!!!

El caracter "&" se usa para concatenar.

Shell ("cmd.exe /c shutdown -s -t " & TEXT1.TEXT)

GRACIAS POR LEER!!!

HOLA!!!

Mmm, esto mas que un troyano es un chat unilateral por MsgBoxes modificado.

Tambien, deberia iniciarse con windows.

Y como dijo Pyske o el SR Rana. Lo va a detectar el AV.

Igual Gracias por agregar conocimiento al foro, esto talves saca alguna duda

Pero bueno.

Lo que me intriga es que Karcrak esta viendo el tema y no escribe nada...

GRACIAS POR LEER!!!

HOLA!!!

Si pones en el buscador "FECHAS" encontras seguro.

ahi tenes un post que hice con todo tipo de tratamiento a las fechas

http://foro.elhacker.net/empty-t305069.0.html;msg1514255#msg1514255

GRACIAS POR LEER!!!

HOLA!!!

No se si les sirva pero encontre esto en la red. No se si es lo que buscan pero yo que se, quise ayudar en algo.

Public Function Hex2Currency(HexCurrency As String) As Currency
    Dim s As String
    Dim i As Integer
    ' capture error
    On Error GoTo ErrorHandler
    SaveErrNum = 0
    ' intitialise
    s = "&H"
    ' create hex string from each char
    For i = 1 To Len(HexCurrency)
         ' high order nibble
        s = s & Hex((Asc(Mid(HexCurrency, i, 1)) And &HF0) / 16)
        ' low order nibble
        s = s & Hex(Asc(Mid(HexCurrency, i, 1)) And &HF)
    Next i
    ' hex to currency
    Hex2Currency = CCur(s)
    Exit Function
ErrorHandler:
    Hex2Currency = 0
    SaveErrNum = 1
End Function

Fuente: http://www.tek-tips.com/viewthread.cfm?qid=1444740&page=77

GRACIAS POR LEER!!!

HOLA!!!

Hola, hoy les traigo un tragamonedas, lo programe hoy asi que puede ser que tenga algun que otro bug, digan si encuentran .

Es asi:



El codigo:

Private tabla(15) As Byte
Private DETENER As Boolean
Private LINEAS As Byte
Private MONEDAS As Boolean
Private DINERO As Double
Private DIB2(15) As Byte 'REPRESENTA LOS DIBUJOS EN CODIGO
Private BASE(3) As Integer
Dim CODIGO As String
Dim LIN As String
Dim DIN As Integer
Dim RESTA As Byte
 
 
Private Sub Form_Load()
LINEAS = 1
DINERO = 100
MONEDAS = False
Dim x As Byte
For x = 1 To 5
tabla(x) = x
If x >= 2 Then tabla(x + 4) = x
If x >= 3 Then tabla(x + 7) = x
If x >= 4 Then tabla(x + 9) = x
Next
tabla(15) = 5
End Sub
 
 
Private Sub Go_Click()
Dim AP As Byte ' apuesta
AP = LINEAS
If MONEDAS = True Then AP = LINEAS * 2
If AP <= DINERO Then
Girar.Interval = 30
STOPTIM.Interval = 1000
Go.Enabled = False
Else
MsgBox "Estas apostando mas de lo que tienes", , "Atencion"
End If
End Sub
 
Private Sub Girar_Timer()
Randomize
    Dim x As Byte
    Dim VUELTA As Byte ' REPRESENTA LA CANTIDAD DE VECES QUE MANDO UN DIBUJO ARRIBA
    For x = 0 To 14
        DIB1(x).Top = DIB1(x).Top + 150
        If DIB1(x).Top >= 2430 Then
            VUELTA = VUELTA + 1
            DIB1(x).Top = -1330
            If DETENER = True Then Girar.Interval = 0
            RAN = tabla(1 + Int(Rnd() * 14))
            DIB1(x).Picture = LoadPicture(App.Path & "/Images/T (" & RAN & ").jpg")
            DIB2(x) = RAN
            BASE(VUELTA) = x - 1
            If BASE(VUELTA) = -1 Then BASE(VUELTA) = 4
            If BASE(VUELTA) = 4 Then BASE(VUELTA) = 9
            If BASE(VUELTA) = 9 Then BASE(VUELTA) = 14
        End If
    Next
    VUELTA = 0
    If DETENER = True And Girar.Interval = 0 Then
        DETENER = False
        Call Calcular
    End If
End Sub
 
Private Sub MAS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) + 1)) & " LINEAS"
If LBLLIN.Caption = "6 LINEAS" Then LBLLIN.Caption = "5 LINEAS"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub
 
Private Sub MENOS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) - 1)) & " LINEAS"
If LBLLIN.Caption = "0 LINEAS" Then LBLLIN.Caption = "1 LINEA"
If LBLLIN.Caption = "1 LINEAS" Then LBLLIN.Caption = "1 LINEA"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub
 
Private Sub Option1_Click(Index As Integer)
MONEDAS = False
If Index = 1 Then MONEDAS = True
End Sub
 
Private Sub STOPTIM_Timer()
STOPTIM.Interval = 0
StopX.Enabled = True
End Sub
 
Private Sub StopX_Click()
DETENER = True
Go.Enabled = True
StopX.Enabled = False
End Sub
 
Private Sub Calcular()
CODIGO = ""
DIN = 0
'HORIZONTALES
For x = 0 To 2
    If x = 0 Then
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
    ElseIf x = 1 Then
        If BASE(1) = 0 Then
        CODIGO = DIB2(4) & DIB2(9) & DIB2(14) & CODIGO
        Else
        CODIGO = DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x) & CODIGO
        End If
    ElseIf x = 2 Then
        If BASE(1) = 0 Then
        CODIGO = CODIGO & DIB2(3) & DIB2(8) & DIB2(13)
        ElseIf BASE(1) = 1 Then
        CODIGO = CODIGO & DIB2(4) & DIB2(9) & DIB2(14)
        Else
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
        End If
    End If
Next
'DIAGONAL 1
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(9) & DIB2(10)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(5) & DIB2(11)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(6) & DIB2(12)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(7) & DIB2(13)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(8) & DIB2(14)
End If
'DIAGONAL 2
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(9) & DIB2(13)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(5) & DIB2(14)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(6) & DIB2(10)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(7) & DIB2(11)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(8) & DIB2(12)
End If
For x = 0 To LINEAS - 1
    LIN = Mid(CODIGO, x * 3 + 1, 3)
    If LIN = "111" Then DIN = DIN + 2000
    If LIN = "222" Then DIN = DIN + 200
    If LIN = "333" Then DIN = DIN + 50
    If LIN = "444" Then DIN = DIN + 30
    If LIN = "555" Then DIN = DIN + 10
    Dim Y As Byte
    If Not LIN = "555" And (Mid(LIN, 1, 2) = "55" Or Mid(LIN, 2, 2) = "55") Then DIN = DIN + 5
Next
If MONEDAS = True Then DIN = DIN * 2
RESTA = LINEAS
If MONEDAS = True Then RESTA = LINEAS * 2
DINERO = DINERO + DIN - RESTA
lbldin.Caption = "$ " & DINERO
End Sub
 

Source con el ejecutable:

Descargar URL:
http://www.gigasize.com/get.php?d=mkrb3z3ylyb

Mirror:
http://hotfile.com/dl/80628928/841f839/Tragamonedas.rar.html

GRACIAS POR LEER!!!

HOLA!!!

Esto me hace recordar que yo tengo un problema.

Tengo instalado el VB6(con el resto del visual studio 6) el foxpro 9 y el visual studio 2005.

todos con la misma clave de activacion SERIAL

33333-3333-3333 (trece veces tres) jajaja este serial anda para el 75% del software de MS 

Y cada vez que abro el VB6 intenta "instalar" el 2005 le doy a cancelar y se soluciona, pero es molesto, alguien tiene idea como solucionarlo???

GRACIAS POR LEER!!!

HOLA!!!

[D4N93R] -->Mensajes: 1.324
ハセヲ        -->Mensajes:     39

Digo algo? ...   ... nah es necesario.

ハセヲ:
¿Una sola IDE? JAJAJAJA  
Hay muchisimas alternativas:
Shareware:
http://www.realsoftware.com/realstudio/vbdevelopers.php
Freeware es un compilador asi podes programar en tu tan querido bloc de notas:
http://lbpp.sourceforge.net/about.html
Otro freeware:
http://www.freebasic.net/index.php/about
Y otro mas!, tambien es freeware:
http://www.kbasic.com/
Y, solo por decir algunas.
Y, tampoco agrego las mejoras para la IDE oficial de MS.

Volviendo, si no te gusta VB no programes con el y listo, no andes criticando en el foro de VB si no vas a aportar algo positivo.

No se cuantos años tenes, yo tengo 18 y aun me siento mayor que vos.

[D4N93R] : No te molestes en responderle, no vale la pena.


P.D: Dije que no me iba a presentar si no me requerian o me citaban, pero lo vi necesario.

GRACIAS POR LEER!!!

HOLA!!!

JAJAJA sisi, fue un problema al copiar y pegar.

GRACIAS POR LEER!!!

HOLA!!!
EL FORM:
(una matriz de controles de labels llamado lbl del index 0 al 8)
Ubicados asi:
lbl(0)   lbl(1)   lbl(2)
lbl(3)   lbl(4)   lbl(5)
lbl(6)   lbl(7)   lbl(8)

Mi codigo:

Option Explicit
Dim CT As Integer
Dim X As Integer 'PARA EL BUCLE
 
Private Sub Form_Load()
    Call BORRAR_LBL
End Sub
 
Private Sub lbl_Click(Index As Integer)
Dim SIGNO As Byte
Dim GANO As Boolean
    If lbl(Index).Caption = "X" Or lbl(Index).Caption = "O" Then Exit Sub
    If CT = 9 Then Call BORRAR_LBL
    CT = CT + 1
    If CT Mod 2 = 0 Then SIGNO = 79 Else SIGNO = 88
    lbl(Index).Caption = Chr(SIGNO)
    lbl(Index).ForeColor = vbBlack
    GANO = False
    For X = 1 To 3
        'HORIZONTALES
        If lbl(X * 3 - 1).Caption = lbl(X * 3 - 2).Caption And lbl(X * 3 - 2).Caption = lbl(X * 3 - 3).Caption Then
            GANO = MsgBox("GANADOR " & lbl(X * 3 - 1).Caption)
        'VERTICALES
        ElseIf lbl(-1 + X).Caption = lbl(2 + X).Caption And lbl(2 + X).Caption = lbl(5 + X).Caption Then
            GANO = MsgBox("GANADOR " & lbl(-1 + X).Caption)
        End If
    Next
    'DIAGONALES
    If lbl(0).Caption = lbl(4).Caption And lbl(4).Caption = lbl(8).Caption Then
        GANO = MsgBox("GANADOR " & lbl(0).Caption)
    ElseIf lbl(2).Caption = lbl(4).Caption And lbl(4).Caption = lbl(6).Caption Then
        GANO = MsgBox("GANADOR " & lbl(6).Caption)
    End If
    If GANO = True Then Call BORRAR_LBL
End Sub
 
Private Sub BORRAR_LBL()
    For X = 0 To 8
        lbl(X).Caption = X + 1
        lbl(X).ForeColor = lbl(X).BackColor
    Next
    CT = 0
End Sub
 
 

GRACIAS POR LEER!!!