| |
|
283
|
Programación / Programación Visual Basic / Re: [RETO] uCaseCorrect. Corrector de Mayusculas!
|
en: 16 Febrero 2011, 20:13 pm
|
Bueno, aquí dejo mi forma de hacerlo  : Con una clase: Option Explicit '====================================================================== ' º Class : cFrogUCase.cls ' º Version : 1.3 ' º Author : Mr.Frog © ' º Country : Spain ' º Mail : vbpsyke1@mixmail.com ' º Date : 16/02/2011 ' º Twitter : http://twitter.com/#!/PsYkE1 ' º Recommended Websites : ' http://foro.h-sec.org ' http://visual-coders.com.ar ' http://InfrAngeluX.Sytes.Net '====================================================================== Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long) Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long Private Declare Function IsCharLowerA Lib "user32" (ByVal cChar As Integer) As Long Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal cChar As Integer) As Long Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long Private lngAscHeader&(0 To 5) Private intAsc%() Friend Function CorrectUCase(ByRef strText$) As String Dim lngLength&, Q& lngLength = LenB(strText) \ 2 If lngLength Then lngAscHeader(3) = StrPtr(strText) Do While Q < lngLength If IsCharAlphaNumericA(intAsc(Q)) Then If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32 Exit Do End If Q = Q + 1 Loop Q = Q + 1 Do While Q < lngLength If intAsc(Q) < 64 Then Select Case intAsc(Q) Case 33, 46, 63 '! . ? Do Q = Q + 1 Select Case intAsc(Q) Case 59, 44, 46 '; , . Q = Q + 1 GoTo Next_: End Select Loop While Q < lngLength And IsCharAlphaNumericA(intAsc(Q)) = 0 If IsCharLowerA(intAsc(Q)) Then intAsc(Q) = intAsc(Q) - 32 End Select End If Next_: Q = Q + 1 Loop PutMem4 VarPtr(CorrectUCase), SysAllocStringByteLen(VarPtr(intAsc(0)), lngLength + lngLength) End If End Function Private Sub Class_Initialize() lngAscHeader(0) = &H1&: lngAscHeader(1) = &H2&: lngAscHeader(4) = &H7FFFFFFF PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0)) End Sub Private Sub Class_Terminate() PutMem4 VarPtrArray(intAsc), 0& End Sub
Prueba: Private Sub Form_Load() Dim c As New cFrogUCase Debug.Print c.CorrectUCase("¿hola como estás? esto es sólo una prueba Miguel... y además : ¡funciona genial! amo a las ranas!.") Set c = Nothing End Sub
Retorno: ¿Hola como estás? Esto es sólo una prueba Miguel... Y además : ¡funciona genial! Amo a las ranas!. DoEvents!  |
|
|
|
|
286
|
Programación / Programación Visual Basic / Re: [RETO] IsFibonacciNumber(N as long) as Boolean
|
en: 16 Febrero 2011, 08:55 am
|
rana, pone los otros codigos tambien.
No solamente los que buscan en arrays.
Manejando arrays soy un queso. ¿Ya está puestos en la pág anterior no?  @ignorantev1.1Dios, soy un desastre, al llamar tu constante igual que la mía, al copiarlo para el test, copié la mía en vez de la tuya...  PD: Tabla de resultados actualizada!  DoEvents! |
|
|
|
|
287
|
Programación / Programación Visual Basic / Re: [RETO] IsFibonacciNumber(N as long) as Boolean
|
en: 16 Febrero 2011, 00:28 am
|
Ya está corregida.  Test: Option Explicit
Private Const sF As String = " 0 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 "
Function isfibonacciIgno(IngNum As Long) As Boolean
isfibonacciIgno = InStr(sF, " " & IngNum & " ")
End Function
Public Static Function IsFibonacci_WithCache_MrFrog(ByRef lngNum As Long) As Boolean
IsFibonacci_WithCache_MrFrog = InStrB(1, sF, " " & lngNum & " ")
End Function
Public Function IsFibonacci_WithCache(ByRef vVal As Long) As Boolean
Dim lng_i As Long
Dim var_cache()
var_cache() = Array(0, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, 317811, 514229, 832040, 1346269, 2178309, 3524578, 5702887, 9227465, 14930352, 24157817, 39088169, 63245986, 102334155, 165580141, 267914296, 433494437, 701408733, 1134903170, 1836311903)
For lng_i = 0 To UBound(var_cache)
If var_cache(lng_i) = vVal Then IsFibonacci_WithCache = True: Exit For
Next lng_i
End Function
Public Function FibonacciChecker_eCode(ByRef lNumero As Long) As Boolean
Dim FiSplit() As String
Dim i As Long
Const Fi As String = "0,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368"
FiSplit() = Split(Fi, ",", -1, vbBinaryCompare)
For i = 0 To 23
If lNumero = CLng(FiSplit(i)) Then FibonacciChecker_eCode = True: Exit Function
If lNumero < CLng(FiSplit(i)) Then FibonacciChecker_eCode = False: Exit Function
Next i
End Function
Private Sub Form_Load()
If App.LogMode = 0 Then End 'Compile it, stupid!
Dim t As New CTiming
Dim x As Long
AutoRedraw = True
t.Reset
For x = 0 To 100000
IsFibonacci_WithCache_MrFrog x
Next
Me.Print "MrFrog", , t.sElapsed
t.Reset
For x = 0 To 100000
isfibonacciIgno x
Next
Me.Print "ignorantev1.1", , t.sElapsed
t.Reset
For x = 0 To 100000
IsFibonacci_WithCache x
Next
Me.Print "BlackZer0x", , t.sElapsed
t.Reset
For x = 0 To 100000
FibonacciChecker_eCode x
Next
Me.Print "Elemental Code", t.sElapsed
End Sub Resultado:  DoEvents! |
|
|
|
|
288
|
Programación / Programación Visual Basic / Re: [RETO] IsFibonacciNumber(N as long) as Boolean
|
en: 15 Febrero 2011, 19:53 pm
|
Ook, con trampa creo que gano... Private Const sF As String = " 0 1 2 35 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 165580141 267914296 433494437 701408733 1134903170 1836311903 " Public Static Function IsFibonacci_WithCache_MrFrog(ByRef lngNum As Long) As Boolean IsFibonacci_WithCache_MrFrog = InStrB(1, sF, " " & lngNum & " ") End Function
DoEvents! |
|
|
|
|
|
| |
|
Mostrar Mensajes
