Source code for Issue Number 108

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new module and paste this source code into it. Change the name of the module to basGUID. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    basFormUtils
'   Written By:     C&D Programming Corp.
'   Create Date:    11/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal lNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "User32" _
    Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal lIndex As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const MF_BYPOSITION = &H400
Private Const MF_BYCOMMAND = &H0
Private Const MAXIMIZE_BUTTON_MASK = &HFFFEFFFF
Private Const MINIMIZE_BUTTON_MASK = &HFFFDFFFF

' These are the command values for the various options on the system menu.
Enum enumMenuType
    mtMove = &HF010
    mtSize = &HF000
    mtMinimize = &HF020
    mtMaximize = &HF030
    mtClose = &HF060
    mtRestore = &HF120
End Enum

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

Private Declare Function RemoveMenu Lib "User32" _
    (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

'
'   Remove a system menu option, such as close, minimize, size or move.
'
'
Public Sub RemoveSystemMenu(ByVal frm As Form, ByVal eMenu As enumMenuType)

    Dim lSystemMenu As Long
    Dim lWindowStyle As Long
    Dim lRet As Long

    lSystemMenu = GetSystemMenu(frm.hWnd, 0&)
    'Call RemoveMenu(lSystemMenu, eMenu, MF_BYPOSITION)

    Select Case eMenu
        Case mtClose, mtMove, mtSize, mtRestore
            Call RemoveMenu(lSystemMenu, eMenu, MF_BYCOMMAND)
        Case mtMinimize
            Call RemoveMenu(lSystemMenu, eMenu, MF_BYCOMMAND)
            ' also remove the minimize button widget on the top right of the window
            lWindowStyle = GetWindowLong(frm.hWnd, GWL_STYLE)
            lWindowStyle = lWindowStyle And MINIMIZE_BUTTON_MASK
            Call SetWindowLong(frm.hWnd, GWL_STYLE, lWindowStyle)
        Case mtMaximize
            Call RemoveMenu(lSystemMenu, eMenu, MF_BYCOMMAND)
            ' also remove the maximize button widget on the top right of the window
            lWindowStyle = GetWindowLong(frm.hWnd, GWL_STYLE)
            lWindowStyle = lWindowStyle And MAXIMIZE_BUTTON_MASK
            Call SetWindowLong(frm.hWnd, GWL_STYLE, lWindowStyle)
    End Select
End Sub