Foro de elhacker.net

Buenas, tengo un pequeño problema con una aplicacion que no me carga un cursor, debido a esto me vi obligado a usar varias APIs para cargar el cursor. En si la aplicacion si cargo el cursor correctamente pero solo hasta que se mueve el mouse luego de eso regresa al anterior :S.

La idea es cargar el cursor en la aplicacion y cuando esta cierre que el cursor quede como estaba.

Aca les dejo el code que encontre pero es el que cambia al mover el cursor:

 
    Private Declare Function LoadCursorFromFile Lib "user32.dll" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
    Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
 
    ' Display the application starting (arrow and hourglass) Windows
    ' cursor for three seconds. The cursor resource is loaded from Windows. Then
    ' restore the old cursor (whatever it happens to be).
 
    Dim hcursor    As Long ' receives handle to application starting cursor
    Dim holdcursor As Long ' receives handle to previously used cursor
    Dim retval     As Long ' throw-away return value
 
    hcursor = LoadCursor(0, IDC_APPSTARTING) ' load Windows's application starting cursor
    holdcursor = SetCursor(hcursor) ' set it to the new cursor
 
    Sleep 3000 ' wait for 3 seconds 
 
    retval = SetCursor(holdcursor) ' set it to the previous cursor
 
 

NOTA: Intente cambiando el cursor actual con SetSystemCursor pero no creo que eso sea buena idea ya que despues hay que restaurar el cursor de forma manual :S.

No uses Sleep, usa doevents, BlackZeroX tiene una funcion que te puede ayudar

Si lo intente con DoEvents pero inmediatamente despues de cambiar el cursor vuelve al anterior :S

HOLA!!!

Intentaste no usar el cursor, usa un shape o form o picturebox o lo que sea que persiga al mouse, entonces tenes un mouse "visible".

GRACIAS POR LEER!!!

Esporque tenes que hacer doevents mediante 3 segundos, con algun bucle o algo :P

:¬¬ Entonces porque no usar Sleep() :huh:

Aun asi, la cosa seria como esto:

Karcrack, porque el sleep congela todo :xD

Creo que no me entendieron mucho de que se trata :S, bueno aqui subi un projecto de ejemplo: http://www.megaupload.com/?d=T0HXO5OF

Ok el codigo es este:

Option Explicit
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function LoadCursorFromFile Lib "user32.dll" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
 
Private Sub Form_Load()
 
    Dim hCursor    As Long
    Dim holdcursor As Long
    Dim retval     As Long
 
    hCursor = LoadCursorFromFile(App.Path & "\AB1.cur")
 
    If hCursor = 0 Then End
 
    holdcursor = SetCursor(hCursor)
 
    Sleep 3000 ' Mientras la aplicacion se encuentra pausada el cursor se mantiene
 
    retval = SetCursor(holdcursor) ' si se anula esta linea para no restaurar el cursor anterior, igual vuelve a como estaba antes :S.
 
End Sub
 
 

Lo que quiero lograr es que el cursor se mantenga hasta finalizar la aplicacion o llamar a la funcion para restaurarlo. Alguna idea del porque el cursor vuelve a como estaba?

Option Explicit
 
Private Declare Function SetCursor Lib "user32.dll" (ByVal hcursor As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Const IDC_APPSTARTING As Long = 32650
Private Const IDC_ARROW As Long = 32512&
Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Dim normal As Long, wait As Long
 
Private Sub Form_Load()
    wait = LoadCursor(0&, IDC_APPSTARTING)
    normal = LoadCursor(0&, IDC_ARROW)
    Esperar 3000
    Call SetCursor(normal) ' set it to the previous cursor
End Sub
 
Public Sub Esperar(Miliseconds As Long)
    Dim retraso As Long
    'GetTickCount devuelve un valor inicial, y se lo sumamos al de retraso
    retraso = Miliseconds + GetTickCount
    While retraso >= GetTickCount
        DoEvents
        Call SetCursor(wait)
    Wend
End Sub
 

El problema fue que apenas se ponia el cursor, se cambiaba el cursor a otro segun el evento de una ventana  :P por eso en ese bucle, forzamos a mostrar nuestro cursor :P

¿Lo que buscas no es esto? :huh:

Option Explicit
 
Private Declare Function LoadCursorFromFile Lib "user32.dll" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
 
Private hOldCursor              As Long
Private bStop                   As Boolean
 
Private Sub Form_Load()
Dim hCursor                     As Long
 
    hCursor = LoadCursorFromFile("c:\bullseye.cur")
 
    If hCursor = 0 Then End
 
    Me.Show: DoEvents
 
    Do While bStop = False
        hOldCursor = SetCursor(hCursor)
        DoEvents
    Loop
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    bStop = True
    Call SetCursor(hOldCursor)
End Sub

DoEvents! :P

Mr. Frog © estas en lo correcto algo asi es lo que necesito, pero hay un problema, ya habia intentado algo asi y resulta que en la aplicacion en la que quiero implementar la funcion para cambiar el mouse ya tiene un sub que entra en un bucle y por lo tanto uno de los dos bucles no se ejecutara :S, Alguna otra idea?

Mezcla los 2 eventos :P Que tipo de bucle es ?

Lo haria pero pasa que si se mezclan entonces el mouse no se redibuja con la frecuencia suficiente como para simular que el cursor no cambia :S, Es un bucle encargado de pintar en un picturebox el cual siempre se esta ejecutando.

Entonces tienes un problema de repintado, tienes que optimizar el bucle ._.

.
@DarkMatrix

si es para el juego de YuGioh que traes mejor resignate a pasarlo a un motor grafico como DirectX u OpenGL asi no tendras que gastar el procesador en vano.

Funcion Wait (No consume procesador) (http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=6:artwait&catid=2:catprocmanager&Itemid=8)

Tome el ejemplo de la API Guide, saque todas las variable por que no queria estar revisando cuales eran las que se requerian asi que aqui tienes, no se come el proesador, y no para el hilo de tu programa.

'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'   // http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=6:artwait&catid=2:catprocmanager&Itemid=8
'   /////////////////////////////////////////////////////////////
Option Explicit
Private Declare Function WaitMessage Lib "user32" () As Long
Enum eTime
    Horas = 3600
    Minutos = 60
    Segundos = 1
End Enum
 
Private Declare Function CreateCursor Lib "user32" (ByVal hInstance As Long, ByVal nXhotspot As Long, ByVal nYhotspot As Long, ByVal nWidth As Long, ByVal nHeight As Long, lpANDbitPlane As Any, lpXORbitPlane As Any) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Dim hnewcursor As Long  ' newly created cursor
    Dim holdcursor As Long  ' receives handle of default cursor
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
 
    ' Create a 32x32 color cursor shaped somewhat like a yin-yang symbol.
    ' (The bit masks come from Microsoft's documentation on the API cursors function, just to
    ' give them their due credit.)  Note how the masks are loaded into the arrays.  The new
    ' cursor is then set to be the cursor for 10 seconds.
    Dim andbuffer As String, xorbuffer As String  ' buffers for masks
    Dim andbits(0 To 127) As Byte  ' stores the AND mask
    Dim xorbits(0 To 127) As Byte  ' stores the XOR mask
    Dim c As Integer, retval As Long  ' counter and return value
 
    ' Unfortunately, VB does not provide a nice way to load lots of information into an array.
    ' To load the AND and XOR masks, we put the raw hex values into the string buffers
    ' and use a loop to convert the hex values into numeric values and load them into
    ' the elements of the array.  Yes, it's ugly, but there's no better way.  Note the
    ' use of the line-continuation character here.  Each sequence of eight hex
    ' characters represents one line in the 32x32 cursor.
    andbuffer = "FFFC3FFF" & "FFC01FFF" & "FF003FFF" & "FE00FFFF" & _
            "F701FFFF" & "F003FFFF" & "F003FFFF" & "E007FFFF" & _
            "C007FFFF" & "C00FFFFF" & "800FFFFF" & "800FFFFF" & _
            "8007FFFF" & "8007FFFF" & "0003FFFF" & "0000FFFF" & _
            "00007FFF" & "00001FFF" & "00000FFF" & "80000FFF" & _
            "800007FF" & "800007FF" & "C00007FF" & "C0000FFF" & _
            "E0000FFF" & "F0001FFF" & "F0001FFF" & "F8003FFF" & _
            "FE007FFF" & "FF00FFFF" & "FFC3FFFF" & "FFFFFFFF"
    xorbuffer = "00000000" & "0003C000" & "003F0000" & "00FE0000" & _
            "0EFC0000" & "07F80000" & "07F80000" & "0FF00000" & _
            "1FF00000" & "1FE00000" & "3FE00000" & "3FE00000" & _
            "3FF00000" & "7FF00000" & "7FF80000" & "7FFC0000" & _
            "7FFF0000" & "7FFF8000" & "7FFFE000" & "3FFFE000" & _
            "3FC7F000" & "3F83F000" & "1F83F000" & "1F83E000" & _
            "0FC7E000" & "07FFC000" & "07FFC000" & "01FF8000" & _
            "00FF0000" & "003C0000" & "00000000" & "00000000"
    ' Now load these hex values into the proper arrays.
    For c = 0 To 127
        andbits(c) = Val("&H" & Mid(andbuffer, 2 * c + 1, 2))
        xorbits(c) = Val("&H" & Mid(xorbuffer, 2 * c + 1, 2))
    Next c
    ' Finally, create this cursor!  The hotspot is at (19,2) on the cursor.
    hnewcursor = CreateCursor(App.hInstance, 19, 2, 32, 32, andbits(0), xorbits(0))
    ' Set the new cursor as the current cursor for 10 seconds and then switch back.
   wait 10000, Horas   'Wait 10000 horas jeje haber que pc aguanta esto encendida...
    retval = SetCursor(holdcursor)  ' change cursor back
    ' Destroy the new cursor.
    retval = DestroyCursor(hnewcursor)
End Sub
Public Sub wait(ByVal vToWait&, Optional ByVal ThisWait As eTime = Segundos, Optional ByVal UseAllProc As Boolean = False)
Dim vDateE      As Date
    vDateE = DateAdd("s", vToWait& * (ThisWait + 0), Time)
    Do While vDateE > Time
        holdcursor = SetCursor(hnewcursor)  ' change cursor
        Call WaitMessage
        If Not UseAllProc Then DoEvents
    Loop
End Sub
 
 

P.D.: Adapta el codigo y metelo a un modulo de clase y donde puse holdcursor = SetCursor(hnewcursor)  ' change cursor puedes meter un RaiseEvent... solo para notificar por mensajes entrantes asi se puede malear el proceso Wait()...

Temibles Lunas!¡.