AllAPI Network - The KPD-Team

 
Allapi Network
 API-Guide
 ApiViewer

 API List

 
API Resources
 Tips & Tricks
 VB Tutorials
 Error Lookup
 
Misc Stuff
 VB examples
 VB Tools
 VB Links
 Top Downloads
 
This Site
 Search Engine
 Contact Form
 

Donate to AllAPI.net

Sub-Classing: Adding an About box to the control menu.

This week I will show you how to do something that I have always wanted to do. I remember reading many magazines with a similar question to this, but all of them just say that it is not possible in Visual Basic, well I have found a solution to this problem which includes sub-classing which I featured in last weeks newsletter.

Editor Note: This tips only works in Visual Basic 5, as previous versions of VB do not support the AddressOf operator.

Here goes!

1. Start a new Standard-Exe project, form1 is created by default.

2. Add a standard module to the project, project menu and click 'add module'

3. The new module should open up by default. Add the following code.

Remember and I keep telling people you write to me and say my samples do not work. Make sure that the API declarations are one line

Option Explicit

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

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

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

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 Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const IDM_ABOUT As Long = 1010
Public lProcOld As Long

Public Function SysMenuHandler(ByVal hWnd _
As Long, ByVal iMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long

If iMsg = WM_SYSCOMMAND Then
    If wParam = IDM_ABOUT Then
        MsgBox "About . . .", vbInformation, "About"
        Exit Function
    End If
End If

SysMenuHandler = CallWindowProc(lProcOld, _
hWnd, iMsg, wParam, lParam)
End Function

Public Function SubClass(FormName As Form)
Dim lhSysMenu As Long, lRet As Long

lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, _
vbNullString)
lRet = AppendMenu(lhSysMenu, MF_STRING, _
IDM_ABOUT, "About...")

FormName.Show
lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, _
AddressOf SysMenuHandler)
End Function

4. Open up the code window for form1 and type the following

Option Explicit

Private Sub Form_Load()
Dim d As String
d = SubClass(Form1) ' Type the name of the form d =
SubClass(<FormName>)
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub

5. I have altered the code to work with any form just specify the form name where I have commented the code.

6. Run the project by clicking on run on the toolbar or from the run menu.

If you click on the control menu then you will see two items. One a separator and the other which says 'About...'. Click on about and a message box appears with my copyright.

 

 


Copyright © 1998-2007, The Mentalis.org Team - Privacy statement
Did you find a bug on this page? Tell us!
This site is located at http://allapi.mentalis.org/