Autor
|
Tema: Obtener puntero de funcion dentro de un form o class. (Leído 13,517 veces)
|
LeandroA
|
Hola BlackZeroX si funciona quizas lo probaste con un STATIC y no recibe el WM_MouseMove proba con BUTTON Class1 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 PrevWndProc As Long Private bvASM(40) As Byte
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private Const WS_VISIBLE As Long = &H10000000 Private mWnd As Long
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(hwnd) End If Debug.Print Msg, wParam, lParam 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 + 28), 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 Class_Initialize() mWnd = CreateWindowEx(0&, "Button", "Hola Mundo", WS_VISIBLE, 0&, 0&, 300, 300, 0&, 0&, App.hInstance, ByVal 0&) If mWnd <> 0 Then Call SetSubclassing(Me, mWnd) End Sub
Private Sub Class_Terminate() If mWnd <> 0 Then Call StopSubclassing(mWnd) DestroyWindow mWnd End If End Sub
Saludos.
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
... Edito:Cuando declaro algunas cosas mas crashea ... ya encontre el horror, es que el ASM modifica la 1ra cosa publica y como tenia una variable publica pues crasheaba ya que no era mi WinProc... Dim c As Class1 Private Sub Form_Load() Set c = New Class1 End Sub
Option Explicit Private Const GWL_WNDPROC As Long = -4 Private Const WM_DESTROY As Long = &H2 Private Const WS_VISIBLE As Long = &H10000000 Private Const MAX_PATH As Integer = 260 Private Const MAXDWORD As Long = &HFFFF Private Const INVALID_HANDLE_VALUE As Long = -1 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA '// Bytes... dwFileAttributes As Long '// 4 ftCreationTime As FILETIME '// 8 ftLastAccessTime As FILETIME '// 8 ftLastWriteTime As FILETIME '// 8 nFileSizeHigh As Long '// 4 nFileSizeLow As Long '// 4 dwReserved0 As Long '// 4 dwReserved1 As Long '// 4 cFileName As String * MAX_PATH '// MAX_PATH*2 = 260*2 = 520 cAlternate As String * 14 '// 14*2 = 28 End Type '// total bytes: 592 bytes... = &H250 Private Declare Function WaitMessage Lib "user32" () As Long Private Declare Function lstrcmp Lib "KERNEL32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long Private Declare Function FindFirstFile& Lib "KERNEL32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA) Private Declare Function FindNextFile& Lib "KERNEL32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA) Private Declare Function GetFileAttributes Lib "KERNEL32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long Private Declare Function FindClose Lib "KERNEL32" (ByVal hFindFile As Long) As Long ' // SubClassing 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 Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Private bIni As Boolean Private sDir As String Private sCriterios() As String Private bIncludeFolders As Boolean Private bCancel As Boolean Private tVBFAFoundInDir As VbFileAttribute Private tVBFAFoundInFile As VbFileAttribute Private lhSearchF() As Long Private lsIndex(0 To 1) As Long Private dblBytesNow_ As Double Private tWFDFound As WIN32_FIND_DATA Private bRun As Boolean Private bFound As Boolean Private bPause As Boolean 'public AllowEvents As Boolean ' // No pongan nada en modo publico xS. private bAllowEvents As Boolean ' // No pongan nada en modo publico xS. Private PrevWndProc As Long Private bvASM(40) As Byte Private mWnd As Long Event Folder(ByRef PathFolder As String) Event File(ByVal TypeOfFile As Long) Event Begin() Event Finish() 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(hwnd) End If Debug.Print Msg, wParam, lParam 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 + 28), 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 Class_Initialize() mWnd = CreateWindowEx(0&, "Button", "Hola Mundo", WS_VISIBLE, 0&, 0&, 300, 300, 0&, 0&, App.hInstance, ByVal 0&) If mWnd <> 0 Then Call SetSubclassing(Me, mWnd) End Sub Private Sub Class_Terminate() If mWnd <> 0 Then Call StopSubclassing(mWnd) DestroyWindow mWnd End If End Sub
Temibles Lunas!¡.
|
|
« Última modificación: 8 Mayo 2011, 11:36 am por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
F3B14N
Desconectado
Mensajes: 47
|
En modulos clase:
Call CopyMemory(WindowProcAddress, ByVal (pVar + &H1C + (ProcIndex * 4&)), 4)
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
En modulos clase:
Call CopyMemory(WindowProcAddress, ByVal (pVar + &H1C + (ProcIndex * 4&)), 4)
excelente con el ProcIndex podremos hacer varias subclasificaciones con el codigo xD Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
alguien tiene el ASM?, quiero ver que es lo que modifica/hace.
Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
puntero a funcion
Programación C/C++
|
kondrag_X1
|
2
|
3,609
|
30 Abril 2011, 19:49 pm
por leogtz
|
|
|
F1 - Problema con puntero a Función C#
.NET (C#, VB.NET, ASP)
|
Maurice_Lupin
|
0
|
2,185
|
17 Mayo 2012, 16:14 pm
por Maurice_Lupin
|
|
|
Como obtener posicion mouse dentro de scrollpane?
Java
|
juancaa
|
2
|
3,780
|
25 Junio 2012, 11:44 am
por juancaa
|
|
|
copiar contenido dentro de un div class con webbrowser?
.NET (C#, VB.NET, ASP)
|
housedir
|
1
|
2,829
|
6 Agosto 2012, 22:58 pm
por seba123neo
|
|
|
[Resuelto] Obtener dentro de función referencia a llamante
PHP
|
Usuario Invitado
|
2
|
2,294
|
20 Enero 2015, 20:37 pm
por Usuario Invitado
|
|