Mensajes

[Textbox]

Bueno la proxima version podria ser que vs escribas las funciones en un textbox y con un boton diga la velocidad xD
Reto para ustedes, si es q son buenos programadores... xD Quiero ver si lo logran hacer..

¿Qué más da escribirlas en un Textbox que en el proyecto?, no le veo la finalidad ha hacerlo de ese modo.
En estos días arreglaré lo que me han comentado.

DoEvents!

El de Psyke1 no me anduvo, la api esa es al pedo xD, con el shutdown -s -f bastaba

No digas barbaridades, esa es una forma muy fea de hacerlo...
Ya actualicé el código.

DoEvents!

Lo puse porque este tipo de preguntas te las podrías responder tú misma si leyeras algún tutorial de vb, o simplemente buscando en Google, mira:
http://www.recursosvisualbasic.com.ar/htm/tutoriales/control_list_box.htm
Tu primera pregunta estaba resuelta.

DoEvents!

Código (vb,7) [Seleccionar] Expandir


'...
Dim strSerial As String
Select Case text1.Text
    Case "CS 1.6"
        strSerial = "345J -356Ñ - 4444 - WER6"
    Case "FrogCheat"
        strSerial = "Google existe..."
End Select
MsgBox strSerial
'...

DoEvents!

Sin Src...
Por tanto esto no va aquí sino en Software.

DoEvents!

Gracias, unicamente quería demostrar que para mejorar la velocidad de vb no hace falta romperse la cabeza.

Código (vb) [Seleccionar] Expandir


' Hago un poco de trampa usando otra función de vb, solo es una adaptación para usar MidB() como Mid()... :P
Public Static Function fMid(ByRef sText As String, ByVal lngStart As Long, Optional ByVal lngLength As Long) As String
   fMid = MidB$(sText, 1 + lngStart + lngStart, lngLength + lngLength)
End Function

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
Dim t               As New CTiming
Dim x               As Long
Dim ret             As String
Dim s               As String
Const lngLoops      As Long = 100000
Const lngStart      As Long = 34566
Const lngLen        As Long = 10000

   If App.LogMode = 0 Then
       MsgBox "Compile it stupid!", vbCritical
       End
   End If
   
   Show
   AutoRedraw = True
   
   For x = 0 To 100000
       s = s & ChrW$(Rnd * 255)
   Next
   
   Cls
   
   t.Reset
   For x = 1 To lngLoops
       ret = fMid(s, lngStart, lngLen)
   Next
   Print "fMid", t.sElapsed
   
   ret = vbNullString
   
   t.Reset
   For x = 1 To lngLoops
       ret = Mid$(s, lngStart, lngLen)
   Next
   Print "Mid", t.sElapsed
End Sub

Resultado:


DoEvents!

[IIf()]

Bueno, os traigo esta simple función para reemplazar a IIf().
IIf(), es una función muy cómoda de vb, pero no es recomendable usarla en bucles o si se necesita especial agilidad porque es leeeenta.
La mía funciona exactamente igual, con la ventaja de que los argumentos en caso de ser Falso o Verdadero son opcionales.

Código (vb) [Seleccionar] Expandir

Option Explicit

Public Static Function IIfEx(ByVal bolExpresion As Boolean, _
                   Optional ByRef varTruePart As Variant, _
                   Optional ByRef varFalsePart As Variant) As Variant
   If bolExpresion Then
       IIfEx = varTruePart
   Else
       IIfEx = varFalsePart
   End If
End Function


Un pequeño ejemplo de velocidad usando CTiming.cls :

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
Dim t               As New CTiming
Dim x               As Long
Dim ret             As Variant
Const s             As String = "holaa"
Const sCorrect      As String = s
Const sIncorrect    As String = sCorrect & "a"
Const lngLoops      As Long = 100000

   If App.LogMode = 0 Then
       MsgBox "Compile it stupid!", vbCritical
       End
   End If

   Me.AutoRedraw = True
   
   Me.Print "True part"
   Me.Print
   
   t.Reset
   For x = 1 To lngLoops
       ret = IIf((s = sCorrect), 123, 1233)
   Next
   Me.Print "IIf", t.sElapsed
   
   t.Reset
   For x = 1 To lngLoops
       ret = IIfEx((s = sCorrect), 123, 1233)
   Next
   Me.Print "IIfEx", t.sElapsed
   
   Me.Print String$(20, "-")
   Me.Print "False part"
   Me.Print
   
   t.Reset
   For x = 1 To lngLoops
       ret = IIf((s = sIncorrect), 123, 1233)
   Next
   Me.Print "IIf", t.sElapsed
   
   t.Reset
   For x = 1 To lngLoops
       ret = IIfEx((s = sIncorrect), 123, 1233)
   Next
   Me.Print "IIfEx", t.sElapsed
End Sub

Resultado (IIfEx = IIIf ; que le cambié el nombre ) :




Nota: Aún así si se necesita especial velocidad mejor usar If.  

DoEvents!

Me gusta la idea!
Buen trabajo, aún así el SRC es mejorable.

Un pequeño ejemplo:

Código (vb) [Seleccionar] Expandir

If Combo1.Text = "Facil" Then
Vert = 100
ElseIf Combo1.Text = "Normal" Then
Vert = 200
ElseIf Combo1.Text = "Dificil" Then
Vert = 300
End If

Te lo dejo en una línea:

Código (vb) [Seleccionar] Expandir

Vert = Choose(Combo1.ListIndex + 1, 100, 200, 300)

P.D: TIENE UN BUG, NO ESCRIBAN NADA EN EL COMBO SOLO SELECCIONEN

Para corregir eso únicamente tienes que cambiar la propiedad Style de tu combo a :

Código [Seleccionar] Expandir

2 - Dropdown List

DoEvents!

[SystemParametersInfo()]

Yo lo haría así:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, ByRef TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, ByRef NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByRef PreviousState As TOKEN_PRIVILEGES, ByRef ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValueA Lib "advapi32" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LUID) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Type LUID
    UsedPart                    As Long
    IgnoredForNowHigh32BitPart  As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount              As Long
    TheLuid                     As LUID
    Attributes                  As Long
End Type

Private Const Pi                        As Double = 3.14159265358979
Private Const lngDistance               As Long = &HC8

Private Const HWND_TOPMOST              As Long = -1

Private Const SWP_NOSIZE                As Long = &H1
Private Const SWP_NOMOVE                As Long = &H2

Private Const TOKEN_ADJUST_PRIVILEGES   As Long = &H20
Private Const TOKEN_QUERY               As Long = &H8

Private Const SE_PRIVILEGE_ENABLED      As Long = &H2

Private Const EWX_SHUTDOWN              As Long = &H1
Private Const EWX_FORCE                 As Long = &H4

Private bytCount                        As Byte
Private lngHeight                       As Long
Private lngWidth                        As Long
Private sinAngle                        As Single

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Command1.Move Rnd * lngWidth, Rnd * lngHeight
End Sub

Private Sub Form_Load()
    Beep
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE

    With Command1
        lngHeight = Height - .Height * 2
        lngWidth = Width - .Width
    End With

    bytCount = 15
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = True
End Sub

Private Sub Timer1_Timer()
    bytCount = bytCount + 1

    Label2.Caption = CStr(lngSecondsToWait - bytCount) & " seg"
    sinAngle = 6 * bytCount

    With Line1
        .X2 = .X1 + Cos((sinAngle - 90) / 180 * Pi) * lngDistance
        .Y2 = .Y1 + Sin((sinAngle - 90) / 180 * Pi) * lngDistance
    End With

    If bytCount = lngSecondsToWait Then
        ForzeShutDown
        End
    End If
End Sub

Private Sub ForzeShutDown()
Dim myLuid                              As LUID
Dim tkpFinal                            As TOKEN_PRIVILEGES
Dim tkpPrevious                         As TOKEN_PRIVILEGES
Dim lngBuffer                           As Long
Dim lngTokenHwnd                        As Long
Dim lngProcessHwnd                      As Long

    lngProcessHwnd = GetCurrentProcess
    OpenProcessToken lngProcessHwnd, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lngTokenHwnd
    LookupPrivilegeValueA vbNullString, "SeShutdownPrivilege", myLuid

    With tkpFinal
        .PrivilegeCount = 1
        .TheLuid = myLuid
        .Attributes = SE_PRIVILEGE_ENABLED
    End With
   
    AdjustTokenPrivileges lngTokenHwnd, False, tkpFinal, Len(tkpPrevious), tkpPrevious, lngBuffer
    ExitWindowsEx EWX_SHUTDOWN Or EWX_FORCE, True
End Sub

Tambien puedes hacer un hook para deshabilitar el Ctr+Alt+Supr, porque creo que SystemParametersInfo() no funciona en W7...

DoEvents!

Sin duda alguna tiene muy buena pinta, más tarde le hecho un vistazo!

DoEvents!