|
91
|
Programación / Programación Visual Basic / Re: Obtener puntero de funcion dentro de un form o class.
|
en: 8 Mayo 2011, 09:30 am
|
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.
|
|
|
92
|
Programación / Programación Visual Basic / Re: Obtener puntero de funcion dentro de un form o class.
|
en: 7 Mayo 2011, 12:02 pm
|
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 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.
|
|
|
93
|
Programación / Programación Visual Basic / Re: Obtener puntero de funcion dentro de un form o class.
|
en: 5 Mayo 2011, 19:27 pm
|
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. 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.
|
|
|
97
|
Programación / Programación Visual Basic / Re: Proyecto Facebook Spam, 10%
|
en: 16 Abril 2011, 00:07 am
|
Hola aun no entiendo mucho el proposito o bien como funciona, vos recolectas datos de personas para luego enviarle algun tipo de spam o lo que fuere, bien con que cuenta le envias ese spam, ¿se puede enviar un mensage a alguien que no tenes como contacto sin algun tipo de capcha? en respuesta al proyecto mio aun funciona bien.  Saludos.
|
|
|
98
|
Programación / Programación Visual Basic / Re: Problema al poner controles dentro de un ListView.
|
en: 13 Abril 2011, 03:53 am
|
Hola no te combiene superponer el control sobre el listview, lo mejor es si dibujar el boton de Drop cuando el item tiene el foco ya que el control combo box casi seguro tiene otro tamaño que el item del listview y este no es ajustable, entonces cuando haces click dibjuas el Drop con el api DrawEdge o con DrawThemeBackground (si es que queres utilizas los Temas de windows) entonces si haces clik o doble clik llevas un combobox Visible=false justo sobre el RECT del item y desplegas la lista utilizando SendMessage
no se si me entendes pero la idea es utilizar solo un combobox y dibujar los dropbutons
Saludos.
|
|
|
100
|
Programación / Programación Visual Basic / Re: [RETO] GetMaskColor
|
en: 26 Marzo 2011, 00:19 am
|
Aca esta mi función Option Explicit Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long Private Type BuferColor Color As Long Count As Long End Type Private Sub Form_Load() Picture1.AutoRedraw = True Me.BackColor = GetMaskColor(Picture1) End Sub Private Function GetMaskColor(oPic As PictureBox) As Long Dim i As Long, j As Long, x As Long Dim lWidth As Long, lHeight As Long Dim NumIcon As Long Dim aColors() As Long Dim BC() As BuferColor Dim bFind As Boolean Dim lMax As Long, ArrSize As Long lWidth = (oPic.ScaleWidth \ oPic.ScaleHeight) If lWidth = 0 Then lWidth = 1 lWidth = oPic.ScaleWidth \ lWidth lHeight = oPic.ScaleHeight NumIcon = oPic.ScaleWidth \ lWidth ArrSize = (NumIcon * 4) - 1 ReDim aColors(ArrSize) For i = 0 To NumIcon - 1 aColors(j) = GetPixel(oPic.hdc, x, 0) aColors(j + 1) = GetPixel(oPic.hdc, x + lWidth - 1, 0) aColors(j + 2) = GetPixel(oPic.hdc, x, lHeight - 1) aColors(j + 3) = GetPixel(oPic.hdc, x + lWidth - 1, lHeight - 1) j = j + 4 x = x + lWidth Next ReDim BC(ArrSize) x = 0 For i = 0 To ArrSize bFind = False For j = 0 To x If BC(j).Color = aColors(i) Then BC(j).Count = BC(j).Count + 1 bFind = True Exit For End If Next If Not bFind Then BC(x).Color = aColors(i): x = x + 1 Next For i = 0 To x - 1 If BC(i).Count > lMax Then lMax = BC(i).Count GetMaskColor = BC(i).Color End If Next End Function
Seba la idea es obtener un color final, puede que alla un empate en la cantidad de colores pero almenos es una aproximación Saludos.
|
|
|
|
|
|
|