USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página