|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Miscelâneas)
|
|
 |
Título da Dica: Acrescenta um botão ao topo do form (tipo o GetRight)
|
 |
|
|
|
Postada em 2/1/2004 por PC
'****** EM UM FORM *********
Private Sub Form_Load()
Call InitButton(Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnHookButton
End Sub
Public Sub Aiuto_Click()
MsgBox "Olá, vc pediu ajuda!"
End Sub
'*********************************************************
'ponha isto num MODULE
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) 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
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CWPSTRUCT
lParam As Long
wParam As Long
Message As Long
hwnd As Long
End Type
Private Const WM_MOVE As Long = &H3
Private Const WM_SETCURSOR As Long = &H20
Public Const WM_NCPAINT As Long = &H85
Private Const WM_COMMAND As Long = &H111
Private Const BM_SETSTATE As Long = &HF3
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_TOOLWINDOW As Long = &H80
Public Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Public Const VER_PLATFORM_WIN32_NT As Long = 2
Private MyForm As Form
Private GiàIntercettato As Boolean
Private sysVar00_lOSVersion As Long
Private WHook As Long
Public ButtonHwnd As Long
Private frmButt As Form
Private lButtXPos As Long
Public Sub InitButton(frmObj As Form, Optional XPosition As Long = 75)
Dim os As OSVERSIONINFO
Dim retval As Long
os.dwOSVersionInfoSize = Len(os)
retval = GetVersionEx(os)
sysVar00_lOSVersion = os.dwPlatformId
Set MyForm = frmObj
GiàIntercettato = False
Call UnHookButton
Set frmButt = frmObj
lButtXPos = XPosition
'AQUI O BOTAO É ADICIONADO 
ButtonHwnd = CreateWindowEx(WS_EX_TOOLWINDOW, "Button", "?", WS_CHILD + WS_VISIBLE, _
50, 50, 14, 14, frmObj.hwnd, 0, App.hInstance, 0)
WHook = SetWindowsHookEx(4, AddressOf HookProc, 0, App.ThreadID)
Call SetParent(ButtonHwnd, GetParent(frmObj.hwnd))
End Sub
Public Sub UnHookButton()
If lButtXPos > 0 Then
lButtXPos = 0
Call UnhookWindowsHookEx(WHook)
Call DestroyWindow(ButtonHwnd)
End If
End Sub
Public Function HookProc(ByVal ncode As Long, ByVal wParam As Long, Inf As CWPSTRUCT) As Long
Dim FormRect As RECT
Static LastParam As Long
Static lCont As Long
If Inf.hwnd = GetParent(ButtonHwnd) And sysVar00_lOSVersion = VER_PLATFORM_WIN32_WINDOWS Then
If Inf.Message = WM_COMMAND Then
Select Case LastParam
Case ButtonHwnd
Call frmButt.Aiuto_Click
End Select
ElseIf Inf.Message = WM_SETCURSOR Then
LastParam = Inf.wParam
End If
ElseIf Inf.hwnd = frmButt.hwnd Then
If Inf.Message = WM_NCPAINT Or Inf.Message = WM_MOVE Then
Call GetWindowRect(frmButt.hwnd, FormRect)
Call SetWindowPos(ButtonHwnd, 0, FormRect.Right - lButtXPos, _
FormRect.Top + 5, 17, 14, SWP_FRAMECHANGED)
End If
ElseIf Inf.hwnd = ButtonHwnd And sysVar00_lOSVersion = VER_PLATFORM_WIN32_NT Then
If Inf.Message = BM_SETSTATE And Inf.wParam = 0 Then
If GiàIntercettato = False Then
GiàIntercettato = True
Call MyForm.Aiuto_Click
Else
GiàIntercettato = False
End If
End If
End If
HookProc = CallNextHookEx(WHook, ncode, wParam, Inf.lParam)
End Function
|
|
|
|
|
