Using Title Bar? 1

[DickiePotter]

Hello,

Does anyone know how you can use the title bar in procedures such as double_click?
It has no properties so is it possible to change that and make it an editable object?
Also, is it possile to add items to the controlBox menu on the title bar?

Thank-You...
Richard

 

[wanmaster]

I don't think that's gonna be easy. There might be a way by using callback-functions to intercept messages send to the titlebar(controlbox). As far as a know, there's no easy way to implement events for a titlebar, or to add items...

Remedy

 

[edderic]

Option Explicit
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
(ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As _
Long, ByVal lpNewItem As String) As Long

Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As _
Long, ByVal bRevert As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal _
dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)

Public Const SC_NEWMENU = 2
Public Const SC_MINIMIZE = &HF020

Public Const WM_SYSCOMMAND = &H112
Public Const WM_INITMENUPOPUP = &H117

Public Const BITMASK = &HFFFF0000

Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const MF_GREYED = &H1&

Public Function FrmProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

'this allows each form to have its own window proc
'and hence to be able to access its own properties in the Win Proc
FrmProc = FrmFromHwnd(hwnd).WindowProc(hwnd, Msg, wParam, lParam)

End Function

Private Function FrmFromHwnd(hwnd As Long) As Object

Dim lo_Form As Object
Dim ll_Pointer As Long

'make function point to our subclassed form
ll_Pointer = GetWindowLong(hwnd, GWL_USERDATA)
CopyMemory lo_Form, ll_Pointer, 4
Set FrmFromHwnd = lo_Form

'don't forget to clean up afterwards!
CopyMemory lo_Form, 0&, 4

End Function



Form Code
Option Explicit
Private ml_OldWinProc As Long

Private Sub Form_Load()

AddAboutMenu
SubClass

End Sub

Private Sub Form_Unload(Cancel As Integer)

UnSubClass

End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim ll_SysMenu As Long

Select Case Msg

Case WM_SYSCOMMAND

'the user clicked on the new menu item
If wParam = SC_NEWMENU Then
' you can put here whatever you want to run when the menu is clicked
MsgBox "You've clicked the new item"
End If

Case WM_INITMENUPOPUP

'disable the menu option if the form is minimized. If you want
'that it will be enabled, remove the lines below from "If lParam ..."
'till "End If" that found 1 line above the "End Select"
If lParam And BITMASK Then
ll_SysMenu = GetSystemMenu(hwnd, 0)
If wParam = ll_SysMenu Then
EnableMenuItem ll_SysMenu, SC_NEWMENU, ByVal _
IIf(WindowState = vbMinimized, MF_GREYED, 0)
End If
End If

End Select

WindowProc = CallWindowProc(ml_OldWinProc, hwnd, Msg, wParam, lParam)

End Function

Private Sub SubClass()
'store object refernce so we can check its properties later
SetWindowLong Me.hwnd, GWL_USERDATA, ObjPtr(Me)
ml_OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf FrmProc)
End Sub

Private Sub UnSubClass()
If ml_OldWinProc Then
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, ml_OldWinProc)
End If
End Sub

Private Sub AddAboutMenu()

Dim ll_OwnerWindowHandle As Long
Dim ll_MenuHandle As Long

ll_OwnerWindowHandle = Me.hwnd
'Get system menu
ll_MenuHandle = GetSystemMenu(ll_OwnerWindowHandle, False)
'Add new menu item
Call AppendMenu(ll_MenuHandle, MF_SEPARATOR, 0&, 0&amp
'replace the "New Item" below with the text you want to appear on the new
'menu item
Call AppendMenu(ll_MenuHandle, MF_STRING, SC_NEWMENU, "&New Item&quot

End Sub

Eric De Decker
vbg.be@vbgroup.nl

Licence And Copy Protection AxtiveX
Source CodeBook for the programmer

http://www.createsoftware2000.com

 

[DickiePotter]

Looks like you have saved me again, cheers edderic
Thanks to Remedy too, it's nice to know that people are thinking about it even if they don't have a solution.