clsframecontrol.cls

AeroSuite--一组非常漂亮的VISTA控件集

    IsMinimized = (IsIconic(mainHwnd) <> 0)
    
    Select Case wMsg
    ' these messages to be processed whether maximized/minimized or normal
    
    Case WM_DESTROY ' stop subclassing if parent is being destroyed
        m_sysMenu = -1  ' flag to prevent restoring form's original styles
        RemoveProp mainHwnd, "lvImpCB_Ptr"
        NewWndProc = CallWindowProc(hOldWndProc, mainHwnd, wMsg, wParam, lParam)
        m_Terminating = True
        bWasIntercepted = True  ' don't forward this message
        
    Case WM_APPACTIVATE
        If wParam = 0 Then
            m_KeepActive = m_KeepActive Or 1
            m_bIsActive = False
        Else
            m_KeepActive = m_KeepActive And Not 1
        End If
        If m_KeepActive > 1 Then
            DoDrawTitleBar m_bIsActive, True, "wm_appactivate"
        End If
        
    Case WM_GETSYSMENU  ' either called from outside application or click on sysIcon
        lSysMenuMsg = wMsg  ' identify which message is displaying the sysmenu
    
    Case WM_SYSCOMMAND, WM_COMMAND
        ' the system menu comes via wm_syscommand but if shown
        ' with wm_getsysmenu, then it comes via wm_command
            'Debug.Print wParam; lParam; c_MBar.WindowMenu(""); GetSystemMenu(mainHwnd, 0); GetMenu(mainHwnd); GetWindowLong(mainHwnd, GWL_STYLE); GetWindowLong(mainHwnd, GWL_EXSTYLE)
        Select Case wParam
        Case SC_KEYMENU ' check for Alt+Space
            
            
            If lParam = vbKeySpace Then
                If IsMinimized Then
                    ' when minimized without being in taskbar, this is fired when user
                    ' clicks sysIcon or iconic titlebar
                    lSysMenuMsg = wMsg
                Else    ' alt+space, need to track separately 'cause if the
                    ' sysIcon is not in top left corner, menu won't show!
                    PostMessage mainHwnd, WM_GETSYSMENU, SC_KEYMENU, ByVal 0&
                    bWasIntercepted = True
                End If
            ElseIf IsMinimized = False Then
                If lParam < 1 Then
                    ' highlight first menubar item if any
                    SendMessage mainHwnd, WM_SETCURSOR, HTCAPTION, 0&
                    c_MBar.TrackMenuBar Abs(lParam), False, (tBarIcon(0).tRgn <> 0), True, True
                Else
                    c_MBar.TraceHotKey lParam, (tBarIcon(0).tRgn <> 0), True
                End If
                bWasIntercepted = True  ' don't forward this message
            End If
        Case SC_CLOSE, SC_MOVE, SC_SIZE
            ' key system menu items. Call routine to ensure a command isn't
            ' being exectuted that is disabled :: outside code
            If ProcessSysMenuItem(wParam, False) = False Then
                ' ok, send message along & modify system menu if needed
                wMsg = WM_SYSCOMMAND    ' change any wm_command to wm_syscommand
                CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
                c_MBar.WindowMenu("sc_close,move,size") = 0
            End If
            bWasIntercepted = True  ' don't forward this message
        Case SC_MINIMIZE, SC_RESTORE
            If ProcessSysMenuItem(wParam, False) = False Then
                UpdateWindowStyles False, False, 0, WS_THICKFRAME, WS_DLGFRAME
                m_InTransition = True   ' see wm_gettext,wm_geticon
                wMsg = WM_SYSCOMMAND    ' change any wm_command to wm_syscommand
                CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
                TweakSysMenu False
                c_MBar.WindowMenu("sc_minimize,restore") = 0
            End If
            bWasIntercepted = True  ' don't forward this message
        Case SC_MAXIMIZE
            If ProcessSysMenuItem(wParam, False) = False Then
                UpdateWindowStyles False, False, -2, AddRqdStyles(GWL_STYLE, 0, True)
                m_InTransition = True
'                If m_BorderStyle = -1 Then UpdateWindowStyles True, False, 0, WS_CAPTION
                wMsg = WM_SYSCOMMAND
                CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
                TweakSysMenu False
                c_MBar.WindowMenu("sc_maximize") = 0
'                If m_BorderStyle = -1 Then UpdateWindowStyles True, True, 0, WS_CAPTION
            End If
            bWasIntercepted = True
        Case SC_MOUSEMENU, SC_MOUSEMENU + 3 ' << a valid variation of sc_mousemenu
            If IsMinimized Then
                lSysMenuMsg = wMsg  ' identify message that is triggering sysmenu
            Else    ' track separately, see SC_KEYMENU remarks above
                PostMessage mainHwnd, WM_GETSYSMENU, SC_KEYMENU, ByVal 0&
                bWasIntercepted = True
            End If
        Case Else   ' todo: finish up; i.e., SC_NEXT for MDI children
            If wMsg = WM_COMMAND And HiWord(wParam) = 0 And lParam = 0 Then ' menu item
                'Debug.Print "got a menu item "; wParam
'                bWasIntercepted = True
            Else
                'If wParam = WM_SYSCOMMAND Then 'Debug.Print "Unknown wparam "; wParam; lParam
                'Debug.Print "Unknown wparam "; wMsg; wParam; lParam, WM_COMMAND
            End If
        End Select
        
    Case WM_GETICON, WM_GETTEXT
        ' when maximizing/minimizing or restoring from these states,
        ' VB draws the titlebar via USER+xxx messages. Not worth the
        ' hassle to trap for those since they may change. Instead,
        ' we will try to prevent the text & icon from being drawn
        ' while window is in transition & just allow VB to draw
        ' a blank, blue titlebar
        bWasIntercepted = m_InTransition
        
    Case WM_SETICON, WM_SETTEXT ' VB does not send SetText when Me.Caption is used
        ' but other apps can... remove this style to prevent redraw
        UpdateWindowStyles True, True, 0, WS_CAPTION
        CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
        ' add style back & redraw caption
        UpdateWindowStyles True, False, 0, WS_CAPTION
        bWasIntercepted = True
        If wMsg = WM_SETICON Then
            If wParam = 1 Then SetSmallIcon
        End If
        DoDrawTitleBar m_bIsActive, False, "wmseticon/wmsettext"
    
    Case WM_NCCALCSIZE
        ' see if we are calculating the non-client area
        If Not IsMinimized Then
            If p_LockUpdate = False And m_bLockWindow = False Then
            If wParam Then
                DefWindowProc mainHwnd, wMsg, wParam, ByVal lParam
                ConfigureNCandClient lParam
                NewWndProc = WVR_VALIDRECTS  ' special meaning
                bWasIntercepted = True  ' don't forward this message
            End If
            End If
        End If
        m_InTransition = False
    
    Case &H1A   ' still testing "what-ifs" here; i.e., system menu font changes
        'Debug.Print "got overall system change"
        
       
    Case Else
    
        ' messages to be processed only if not minimized
    
        If Not IsMinimized Then
        
        Select Case wMsg
        
        Case WM_WINDOWPOSCHANGED
            ' take into credit desktop toolbars moving around while this is maximized
'            SetRect m_Position.wRect, -1, -1, 0, 0
'            CalculateBarRects True
            c_MBar.DrawMenuBarItems 1, 0, hRect_Menu, m_Position.wRect, -2, 0 ' refresh
            
        Case WM_STYLECHANGED
    '        'Debug.Print "got style change? "; wParam, GetWindowLong(mainHwnd, wParam)
            If m_bLockWindow Or p_LockUpdate Then
                ' self-imposed style changes
                If p_LockUpdate Then p_LockUpdate = False
                If m_bLockWindow Then m_bLockWindow = False
                bWasIntercepted = True
            Else    ' not expected or fired from elsewhere
                If wParam = GWL_STYLE Then
                    ' class requires the GWL_STYLE to remain fairly static
                    ' VB screws up when the original window was borderless and
                    ' additional styles were applied. It tends to revert back
                    ' to a style of borderless or near borderless if a caption
                    ' or sysIcon were modified... Fix that here
                    CopyMemory SS, ByVal lParam, Len(SS)
                    lRtnVal = SS.StyleNew
                    AddRqdStyles wParam, SS.StyleNew, IsZoomed(mainHwnd)
                    If lRtnVal = SS.StyleNew Then
                        CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
                    Else    ' force window to accept our style + the new style
                        UpdateWindowStyles False, False, -2, SS.StyleNew
                    End If
                Else    ' let it go for GWL_EXSTYLE; no known conflicts yet
                    CallWindowProc hOldWndProc, mainHwnd, wMsg, wParam, lParam
                End If
                c_MBar.WindowMenu("stylechanged") = 0
                bWasIntercepted = True
            End If
        
        Case WM_NCACTIVATE  ' nonclient actiating/deactivating
            UpdateWindowStyles True, True, 0, WS_CAPTION
            If wParam Then  ' active
                ' need to pass this to defwndproc per msdn examples
                DefWindowProc mainHwnd, wMsg, wParam, lParam
'                NewWndProc = CallWindowProc(hOldWndProc, mainHwnd, wMsg, wParam, lParam)
            Else    ' trial & error, don't pass this & bad things happen
                ReleaseMouse        ' do if needed
                'MenuBar.ResetMenu
'                DefWindowProc mainHwnd, wMsg, wParam, lParam
                NewWndProc = CallWindowProc(hOldWndProc, mainHwnd, wMsg, wParam, lParam)
            End If
'            'Debug.Print "got ncactivate "; wParam
            ' redraw the titlebar
            UpdateWindowStyles True, False, 0, WS_CAPTION
            c_MBar.WindowMenu("wm_ncactivate") = 0
            DoDrawTitleBar (wParam <> 0), True, "wmncactivate"
            bWasIntercepted = True  ' don't forward this message
        
        Case WM_NCPAINT ' painting non client area
'            'Debug.Print "got ncpaint"; wParam
            DoDrawTitleBar (GetForegroundWindow() = mainHwnd), True, "wm_ncpaint"
            bWasIntercepted = True  ' don't forward this message
            
    
        Case WM_NCHITTEST
'            'Debug.Print "got nc hittest"
            ' important to trick windows
            ' into believing the hittest we want is valid
            NewWndProc = ConvertHitTest(0, False)  ' c_MBar.TrackingState <> 0)
            bWasIntercepted = True  ' don't forward this message
        
        Case WM_NCLBUTTONDOWN
    '         'Debug.Print "got nclbuttondown"
            ' can't have it touch down on Non-client, determine where clicked
            If Not m_bIsActive Then ' could happen some how; check
                SetForegroundWindow mainHwnd
                'DoDrawTitleBar True,true
            End If
            ' figure out what action is expected from x,y location on titlebar
            Select Case SetHitTestAction(wMsg, wParam)
            Case Is < 1 ' ate the action, tell windows NO
                wParam = HTNOWHERE
            Case HTSYSMENU
                ' track sysmenu separately; see wm_sycommand/sc_keymenu remarks above
                PostMessage mainHwnd, WM_GETSYSMENU, SC_KEYMENU, ByVal 0&
                bWasIntercepted = True
            Case HTMINBUTTON, HTMAXBUTTON, HTCAPTION, HTCLOSE
                ' handled already
                bWasIntercepted = True ' don't forward this message
            Case HTLEFT To HTBOTTOMRIGHT    ' borders
                ' remove this style as it prevents resizing vertical captions
                ' to their absoulte minimum width. Add it back after resizing
                UpdateWindowStyles True, True, 0, WS_DLGFRAME
                bWasIntercepted = True
            Case Else ' other actions - don't care
                bWasIntercepted = True ' don't forward this message
            End Select
            
        Case &H211 ' enter menu loop
            'Debug.Print "entering menu loop"
            If wParam = 0 Then UpdateWindowStyles True, True, 0, WS_CAPTION

        Case &H212 ' exit meu loop
            'Debug.Print "exiting menu loop"
            UpdateWindowStyles True, False, 0, WS_CAPTION
    
        Case WM_NCLBUTTONDBLCLK
            Select Case wParam
            Case HTCAPTION  ' maximize or restore
                If IsZoomed(mainHwnd) Then
                    ProcessSysMenuItem SC_RESTORE, True
                Else
                    ProcessSysMenuItem SC_MAXIMIZE, True
                End If
            Case HTSYSMENU ' default sysicon double click
                ' only triggers when window iconic on desktop & nowhere else due
                ' to how sysMenu is handled in this class. See wm_nclbuttonup too
                ProcessSysMenuItem SC_CLOSE, True
            End Select
            ReleaseMouse
            m_Position.Tag = 0
            m_Position.Action = 0
            bWasIntercepted = True  ' don't forward this message
               
        Case WM_MOUSEMOVE, WM_NCMOUSEMOVE ' only used when moving/resizing
    '            'Debug.Print "getting mouse move "; wMsg = WM_NCMOUSEMOVE
            ' nc mouse messages are never forwarded
            If m_Position.Action > 0 Then
                Select Case m_Position.Action
                Case Is < 3 'only if tracking for moving/sizing window or rolling over min/max/close
                    bWasIntercepted = SetNewWindowPos(wParam)
                Case Is > HTMenuPlus, HTMAXBUTTON, HTMINBUTTON, HTCLOSE
                    ' probably dragging over titlebar buttons
                    DoButtonClick wParam, True
                    bWasIntercepted = True
                End Sel