Obtener puntero de funcion dentro de un form o class.

[BlackZeroX]

Not Found

The requested URL /svn/!svn/bc/2/trunk/classes/ClsRueda.cls. was not found on this server.

Dulces Lunas!¡.

[LeandroA]

@BlackZerox: Quitale el punto al final

creo que lo mejor que veas estos links
http://www.activevb.de/tutorials/tut_subclass_asm/tut_subclass_asm.html

y descargate este .zip que esta muy bueno.

http://www.activevb.de/rubriken/klassen/windows/csubclasser/subclasser.zip

pd: yo estoy utilzando estas clases y uc pero me me suelen crashear cuando llama a VirtualFree, creo que esto ocurre cuando llega un msg a WindowProc  y llame a VirtualFree, no quiero dar un ejemplo exacto para no irme por las ramas pero si alguien le encuentra una solución o quiere que entre en detalles que chifle.

Saluods.

[raul338]

@BlackZerox: Quitale el punto al final

creo que lo mejor que veas estos links
http://www.activevb.de/tutorials/tut_subclass_asm/tut_subclass_asm.html

No se aleman pero por lo que vi. Es similar a un codigo que vi de "AND ray" implementando las novedades de win7 en vb (busquen "iTaskBarList3" en planet source code) que llamaba a una interfaz (no probe con objetos) a partir de su ordinal y un maximo de 15 parametros (segun recuerdo) pero no se podia obtener el valor devuelto. Usaba un ASM similar

[F3B14N]

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "USER32" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC As Long = -4
Private Const WM_DESTROY As Long = &H2
Private Const WM_MOUSEMOVE As Long = &H200

Private PrevWndProc As Long
Private bvASM(103) As Byte

Public Function WindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   WindowProc = CallWindowProcA(PrevWndProc, Hwnd, Msg, wParam, lParam)
   
   If Msg = WM_DESTROY Then
       Call StopSubclassing(Me.Hwnd)
   ElseIf Msg = WM_MOUSEMOVE Then
       Me.Caption = Timer
   End If

End Function

Private Sub SetSubclassing(Obj As Object, Hwnd As Long)
   Dim pASMWrapper As Long
   Dim pVar As Long
   Dim pObj As Long
   Dim CallbackFunction As Long
   Dim i As Long
   
   pASMWrapper = VarPtr(bvASM(0))
   pObj = ObjPtr(Obj)

   Call CopyMemory(pVar, ByVal pObj, 4)
    pVar = (pVar + 1784) 'Form
   
   Call CopyMemory(CallbackFunction, ByVal pVar, 4)
   
   For i = 0 To 55
       bvASM(i) = Choose(i + 1, &H90, &HFF, &H5, &H0, &H0, &H0, &H0, &H6A, &H0, &H54, &HFF, &H74, &H24, &H18, &HFF, &H74, &H24, _
                                &H18, &HFF, &H74, &H24, &H18, &HFF, &H74, &H24, &H18, &H68, &H0, &H0, &H0, &H0, &HB8, &H0, &H0, _
                                &H0, &H0, &HFF, &HD0, &HFF, &HD, &H0, &H0, &H0, &H0, &HA1, &H0, &H0, &H0, &H0, &H85, &HC0, &H75, _
                                &H4, &H58, &HC2, &H10, &H0, &HA1, &H0, &H0, &H0, &H0, &H85, &HC0, &H74, &H4, &H58, &HC2, &H10, _
                                &H0, &H58, &H59, &H58, &H58, &H58, &H58, &H68, &H0, &H80, &H0, &H0, &H6A, &H0, &H68, &H0, &H0, _
                                &H0, &H0, &H51, &HB8, &H0, &H0, &H0, &H0, &HFF, &HE0, &H0, &H0, &H0, &H0, &H0, &H0, &H0, &H0)
   Next i

   'Zahler Variable setzen
   pVar = pASMWrapper + 96
   Call LongToByte(pVar, bvASM, 3)
   Call LongToByte(pVar, bvASM, 40)
   Call LongToByte(pVar, bvASM, 58)
       
   'Flag Variable setzen
   pVar = pASMWrapper + 100
   Call LongToByte(pVar, bvASM, 45)
       
   'Wrapper Adresse setzen
   pVar = pASMWrapper
   Call LongToByte(pVar, bvASM, 84)
       
   'Instanzzeiger setzen
   pVar = pObj
   Call LongToByte(pVar, bvASM, 27)
       
   'Funktionszeiger setze
   pVar = CallbackFunction
   Call LongToByte(pVar, bvASM, 32)

   'VirtualFree Adresse setzen
   'pVar = GetProcAddress(GetModuleHandle("KERNEL32"), "VirtualFree")
   'Call LongToByte(pVar, bvASM, 90)
       
   PrevWndProc = SetWindowLongA(Hwnd, GWL_WNDPROC, pASMWrapper)
End Sub

Private Sub StopSubclassing(Hwnd)
   Call SetWindowLongA(Hwnd, GWL_WNDPROC, PrevWndProc)
End Sub

Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
   bReturn(i) = lLong And &HFF
   bReturn(i + 1) = (lLong And 65280) / &H100
   bReturn(i + 2) = (lLong And &HFF0000) / &H10000
   bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub

Private Sub Form_Load()
   Call SetSubclassing(Me, 0, Me.Hwnd)
End Sub


Gracias por la data Leandro, ahi deje el codigo un poco mas limpio para quien lo necesite, igualmente simplificar mucho el asm.

Saludos

[LeandroA]

muy bueno F3B14N, veo que eliminaste VirtualAlloc y VirtualFree con lo que se termino el problema que mencionaba anteriormente al parecer todo funciona de lujo  , además se simplifico mucho mas.

Gracias por compartirlo.

PD: fijate quizas te guste mas para crear el ASM(), creo que asi lo hacia Cobein.

Código [Seleccionar] Expandir


        Dim sCode As String

   
        sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
                "0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
               
        For i = 0 To Len(sCode) - 1 Step 2
            bvASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
        Next

Saludos.

[F3B14N]

muy bueno F3B14N, veo que eliminaste VirtualAlloc y VirtualFree con lo que se termino el problema que mencionaba anteriormente al parecer todo funciona de lujo  , además se simplifico mucho mas.

Gracias por compartirlo.

PD: fijate quizas te guste mas para crear el ASM(), creo que asi lo hacia Cobein.

Código [Seleccionar] Expandir


        Dim sCode As String

   
        sCode = "90FF05000000006A0054FF742418FF742418FF742418FF7424186800000000B800000000FFD0FF0D00000000A10000000085C075" & _
                "0458C21000A10000000085C0740458C2100058595858585868008000006A00680000000051B800000000FFE00000000000000000"
               
        For i = 0 To Len(sCode) - 1 Step 2
            bvASM(i / 2) = CByte("&h" & Mid$(sCode, i + 1, 2))
        Next

Saludos.

Por nada Leandro, aqui esta aun mas simple :

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLongA Lib "USER32" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC As Long = -4
Private Const WM_DESTROY As Long = &H2
Private Const WM_MOUSEMOVE As Long = &H200

Private PrevWndProc As Long
Private bvASM(40) As Byte

Public Function WindowProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProcA(PrevWndProc, Hwnd, Msg, wParam, lParam)
   
    If Msg = WM_DESTROY Then
        Call StopSubclassing(Me.Hwnd)
    ElseIf Msg = WM_MOUSEMOVE Then
        Me.Caption = Timer
    End If
End Function

Private Sub SetSubclassing(Obj As Object, Hwnd As Long)
    Dim WindowProcAddress As Long
    Dim pObj As Long
    Dim pVar As Long
   
    Dim i As Long
   
    For i = 0 To 40
        bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
                                 &HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
                                 &HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
    Next i
   
    pObj = ObjPtr(Obj)
   
    Call CopyMemory(pVar, ByVal pObj, 4)
    Call CopyMemory(WindowProcAddress, ByVal (pVar + 1784), 4)
   
    Call LongToByte(pObj, bvASM, 23)
    Call LongToByte(WindowProcAddress, bvASM, 28)

    PrevWndProc = SetWindowLongA(Hwnd, GWL_WNDPROC, VarPtr(bvASM(0)))
End Sub

Private Sub StopSubclassing(Hwnd)
    Call SetWindowLongA(Hwnd, GWL_WNDPROC, PrevWndProc)
End Sub

Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
    bReturn(i) = lLong And &HFF
    bReturn(i + 1) = (lLong And 65280) / &H100
    bReturn(i + 2) = (lLong And &HFF0000) / &H10000
    bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub

Private Sub Form_Load()
    Call SetSubclassing(Me, 0, Me.Hwnd)
End Sub

[LeandroA]

Simplemente asombroso la verdad acostumbrado a utilizar la clase de Paul Caton  que son muchisimas lineas, con esto esta barbaro.

para informacion a todos, si quieren utilizarlo desde un modulo clase cambiar este valor en esta linea

Código [Seleccionar] Expandir

Call CopyMemory(WindowProcAddress, ByVal (pVar + 1784), 4)
para un modulo clase cambiar 1784 por 28
y para un User Control  por 1956

Seguramente me surjan algunas dudas mas adelante sobre como implementar un subclass y un Api Timer en un mismo modulo o bien dos Sub para distintos hilos.
si tenes idea postealo para agendarlo.

Saludos.

[BlackZeroX]

.
ja ja ja por lo menos no me funciona este codigo creando una ventana con CreateWindowEx y despues sud-clásificandola TODO desde el modulo de clase xP.

cambiando como ya menciono LeandroA: 1784 por 28 en la linea ya indicada anteriormente.

Dulces Lunas!¡.

[F3B14N]

.
ja ja ja por lo menos no me funciona este codigo creando una ventana con CreateWindowEx y despues sud-clásificandola TODO desde el modulo de clase xP.

cambiando como ya menciono LeandroA: 1784 por 28 en la linea ya indicada anteriormente.

Dulces Lunas!¡.

jejerejerejoju

[BlackZeroX]