• Home
 · 
• Miscellaneous
 · 
• This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (abou

This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (abou

This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (about a month ago I've posted a code like this,

API Declarations


Add this code into a 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 "Ciao!"
End Sub




Rate This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (abou

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

 Add this code into a 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

' MiaForm
Private MyForm As Form
' GiàIntercettato
Private GiàIntercettato As Boolean
' Versione di Windows
Private sysVar00_lOSVersion As Long
' handle alla procedura di hook
Private WHook As Long
' handle al bottone
Public ButtonHwnd As Long
' riferimento alla form
Private frmButt As Form
' numero di pixel di scarto dal margine destro della form
Private lButtXPos As Long   ' 75 è il valore di default (posiziona il bottone di help
                            ' alla sinistra dei tre bottoni ControlBox standard)

Public Sub InitButton(frmObj As Form, Optional XPosition As Long = 75)

Dim os As OSVERSIONINFO  ' receives version information
Dim retval As Long  ' return value
    os.dwOSVersionInfoSize = Len(os)  ' set the size of the structure
    retval = GetVersionEx(os)  ' read Windows's version information
    sysVar00_lOSVersion = os.dwPlatformId
    Set MyForm = frmObj
    GiàIntercettato = False
    
    ' rimuove il precedente hooking, se c'è
    Call UnHookButton
    
    ' memorizza i riferimenti di lavoro
    Set frmButt = frmObj
    lButtXPos = XPosition
    
    ' crea il bottone da posizionare nella Titlebar
    ButtonHwnd = CreateWindowEx(WS_EX_TOOLWINDOW, "Button", "?", WS_CHILD + WS_VISIBLE, _
                                50, 50, 14, 14, frmObj.hwnd, 0, App.hInstance, 0)
    ' mostra il bottone (è invisible alla creazione)
    ''Call ShowWindow(ButtonHwnd, 1)
    ' imposta l'hooking del bottone
    WHook = SetWindowsHookEx(4, AddressOf HookProc, 0, App.ThreadID)
    ''Call SetWindowLong(ButtonHwnd, GWL_EXSTYLE, WS_EX_TOOLWINDOW)
    Call SetParent(ButtonHwnd, GetParent(frmObj.hwnd))
    
End Sub

Public Sub UnHookButton()

    If lButtXPos > 0 Then
        ' sgancia l'hook del bottone
        lButtXPos = 0
        Call UnhookWindowsHookEx(WHook)
        ' distrugge il bottone
        ''Call SetParent(ButtonHwnd, frmButt.hwnd)
        Call DestroyWindow(ButtonHwnd)
    End If
    
End Sub

'----------------------------------------------------------------------------------------------
' PROCEDURA DI HOOKING DEI MESSAGGI RELATIVI AL BOTTONE.
'----------------------------------------------------------------------------------------------
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
                ' intercetta il click sul bottone (per Win9x)
                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
            ' legge le dimensioni della form
            Call GetWindowRect(frmButt.hwnd, FormRect)
            ' disegna il bottone nella Titlebar
            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
        ' click sul bottone (per Win NT)
        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
    ' passa il controllo alla successiva procedura nella catena di hooking
    HookProc = CallNextHookEx(WHook, ncode, wParam, Inf.lParam)
    
End Function