by Haeresis (2 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 4th February 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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
No comments have been posted about This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (abou. Why not be the first to post a comment about This code add a button in the Title Bar. This code work with Windows 9* and Windows NT/2000 ! (abou.