cnccalcsize.cls

漂亮的VB版本的界面,界面可以进行扩展并且所需要的代码又非常的少。是一个优秀的原码你可以下载学习之用。

         ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
         s_bChildActivate = False
      End If
      
   Case WM_SIZE
      '
      ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
   
   Case WM_INITMENUPOPUP
      '
      ' During a WM_INITMENUPOPUP, the system redraws the
      ' min/max/close buttons.
      
      
      ' Check HiWord of lParam to see whether this is
      ' a SysMenu:
      If Not (lParam And &HFFFF0000) = 0 Then
         ' Sys Menu:
         ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
      Else
         ' App Menu:
         ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
         If GetImplementation(Implementation) Then
            Implementation.InitMenuPopup wParam, lParam
         End If
      End If
      
   Case WM_ENTERMENULOOP, WM_EXITMENULOOP
      ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
      If iMsg = WM_EXITMENULOOP Then
         If GetImplementation(Implementation) Then
            Implementation.ExitMenuLoop
         End If
      End If
      
   Case WM_SETTEXT, WM_STYLECHANGED, WM_NCLBUTTONDBLCLK
      '
      ' The whole title bar is repainted by the defwindowproc.
      ' Therefore redraw once complete:
      If Not s_bNoStyleChangeProcessing Then
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
      Else
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
      
   Case WM_NCCALCSIZE
      '
      ' No Hacks!
      '
      ' This simply tells windows to modify the client
      ' area to the appropriate size:
      '
      
      ' First set the zoomed MDI Child flag:
      m_bZoomedMDIChild = (IsMDIChildForm(hwnd) And (IsZoomed(hwnd) <> 0))
      If wParam <> 0 Then
      
         ' Get the structure pointed to by lParam:
         CopyMemory tNCR, ByVal lParam, Len(tNCR)
         CopyMemory tWP, ByVal tNCR.lppos, Len(tWP)
         
         'pDebugCalcSize tNCR
         With tNCR.rgrc(0)
            ' Set these
            .left = tWP.x
            .top = tWP.y
            .right = tWP.x + tWP.cx
            .bottom = tWP.y + tWP.cy
                        
            ' Defaults
            m_lLeft = GetSystemMetrics(SM_CXFRAME)
            m_lRight = m_lLeft
            m_lTop = GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME)
            m_lBottom = GetSystemMetrics(SM_CYFRAME)
            
            ' If the window in question is an MDI child, then we
            ' ant to ensure that the standard settings get sent
            ' back to windows: to prevent drawing additional borders,
            ' which aren't required:
            If Not m_bZoomedMDIChild Then
               ' If the implementation is valid then request the
               ' physical size of the title bar and borders:
               If GetImplementation(Implementation) Then
                  Implementation.GetLeftMarginWidth m_lLeft
                  Implementation.GetTopMarginHeight m_lTop
                  Implementation.GetRightMarginWidth m_lRight
                  Implementation.GetBottomMarginHeight m_lBottom
               End If
            End If
            
            ' Set our physical left/top/right/bottom values:
            .left = .left + m_lLeft
            .top = .top + m_lTop
            .right = .right - m_lRight
            .bottom = .bottom - m_lBottom
         End With
         
         ' Return the new client area size to windows:
         LSet tNCR.rgrc(1) = tNCR.rgrc(0)
         CopyMemory ByVal lParam, tNCR, Len(tNCR)
         ISubclass_WindowProc = WVR_VALIDRECTS
         
      Else
         ' lParam points to a rectangle
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
               
      ' Check for the active window:
      'lPtr = VarPtr(lpfMaximised)
      'If Not m_hWndMDIClient = 0 Then
      '   lhWnd = SendMessageLong(m_hWndMDIClient, WM_MDIGETACTIVE, 0, lPtr)
      '   pShowMDIButtons lhWnd, (lpfMaximised <> 0)
      'End If
      
   Case WM_NCACTIVATE
      '
      ' When we get a NC Activate The title bar is
      ' being redrawn to show active or inactive states.
      '
      ' This processing ensures the title bar is updated
      ' correctly following state change:
      '
      
      ' We must call the defwindowproc otherwise VB goes
      ' funny.  This draws a full titlebar:
      m_bActive = Not (wParam = 0)
      ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      
      ' Now fix it:
      ISubclass_WindowProc m_hWnd, WM_NCPAINT, 0, 0
   
   Case WM_ACTIVATEAPP
      '
      ' This is for detecting which app is active
      '
      m_bAppActive = Not (wParam = 0)
   
   End Select
            
End Function
'===================================================
'
'===================================================
Private Function IsMDIChildForm(ByVal hwnd As Long) As Boolean
Dim hWndP As Long
Dim sBuf As String
Dim iPos As Long
   hWndP = GetParent(hwnd)
   sBuf = String$(260, 0)
   GetClassName hWndP, sBuf, 259
   iPos = InStr(sBuf, vbNullChar)
   If iPos > 1 Then
      If left$(sBuf, iPos - 1) = "MDIClient" Then
         IsMDIChildForm = True
      End If
   End If
End Function
'===================================================
'
'===================================================
Private Function pGetHitTestCode() As ECNCHitTestConstants
Dim lStyle As Long
Dim bCanSize As Boolean
Dim Implementation As INCAreaModifier
Dim eHt As ECNCHitTestConstants
Dim tP As POINTAPI
Dim tR As RECT
   
   If GetImplementation(Implementation) Then
      lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
      bCanSize = ((lStyle And WS_SIZEBOX) = WS_SIZEBOX)
      eHt = HTCLIENT
      GetCursorPos tP
      
      GetWindowRect m_hWnd, tR
      tP.x = tP.x - tR.left: tP.y = tP.y - tR.top
      OffsetRect tR, -tR.left, -tR.top
      eHt = HTCLIENT
      If Not (PtInRect(tR, tP.x, tP.y) = 0) Then
         ' Left
         If tP.x <= m_lLeft Then
            If tP.y <= m_lBottom Then
               If bCanSize Then
                  eHt = HTTOPLEFT
               End If
            ElseIf tP.y >= tR.bottom - m_lBottom Then
               If bCanSize Then
                  eHt = HTBOTTOMLEFT
               End If
            Else
               If bCanSize Then
                  eHt = HTLEFT
               End If
            End If
         ' Right
         ElseIf tP.x >= tR.right - m_lRight Then
            If tP.y <= m_lBottom Then
               If bCanSize Then
                  eHt = HTTOPRIGHT
               End If
            ElseIf tP.y >= tR.bottom - m_lBottom Then
               If bCanSize Then
                  eHt = HTBOTTOMRIGHT
               End If
            Else
               If bCanSize Then
                  eHt = HTRIGHT
               End If
            End If
         ' Top/Bottom?
         ElseIf tP.y <= m_lBottom Then
            If bCanSize Then
               eHt = HTTOP
            End If
         ElseIf tP.y >= tR.bottom - m_lBottom Then
            If bCanSize Then
               eHt = HTBOTTOM
            End If
         ' Caption/Menu
         ElseIf tP.y <= m_lTop Then
            ' We assume for default that the caption
            ' is the same as the system caption etc:
            If tP.y <= m_lBottom + GetSystemMetrics(SM_CYCAPTION) Then
               eHt = HTCAPTION
               If tP.x <= GetSystemMetrics(SM_CYCAPTION) Then
                  eHt = HTSYSMENU
               Else
                  ' todo min/max/close btns
               End If
            ElseIf tP.y > m_lBottom + GetSystemMetrics(SM_CYCAPTION) Then
               eHt = HTCLIENT
            End If
         End If
      End If
      Implementation.HitTest tP.x, tP.y, eHt
   End If
   pGetHitTestCode = eHt
   
End Function
'===================================================
'
'===================================================
Public Sub DefaultNCPaint(ByVal hdc As Long, ByVal lLeft As Long, ByVal lTop As Long, ByVal lRight As Long, ByVal lBottom As Long)
Dim tR As RECT, tTR As RECT, tSR As RECT, tBR As RECT
Dim lFlag As Long
Dim hBr As Long, hBrButton As Long

   tR.left = lLeft
   tR.top = lTop
   tR.right = lRight
   tR.bottom = lBottom
   LSet tBR = tR

   If m_bActive Then
      lFlag = DC_ACTIVE
      hBrButton = GetSysColorBrush(COLOR_ACTIVECAPTION)
      hBr = GetSysColorBrush(COLOR_ACTIVEBORDER)
   Else
      hBrButton = GetSysColorBrush(COLOR_INACTIVECAPTION)
      hBr = GetSysColorBrush(COLOR_INACTIVEBORDER)
   End If

   ' Titlebar area:
   ' Draw the part between the edge & the client:
   LSet tTR = tR
   ' left edge
   tTR.top = GetSystemMetrics(SM_CYFRAME)
   tTR.bottom = tTR.bottom - GetSystemMetrics(SM_CYFRAME)
   tTR.right = GetSystemMetrics(SM_CXFRAME)
   FillRect hdc, tTR, hBr
   ' top
   LSet tTR = tR
   tTR.bottom = GetSystemMetrics(SM_CYFRAME)
   FillRect hdc, tTR, hBr
   ' right
   LSet tTR = tR
   tTR.top = GetSystemMetrics(SM_CYFRAME)
   tTR.bottom = tTR.bottom - GetSystemMetrics(SM_CYFRAME)
   tTR.left = tTR.right - GetSystemMetrics(SM_CXFRAME)
   FillRect hdc, tTR, hBr
   ' bottom
   LSet tTR = tR
   tTR.top = tTR.bottom - GetSystemMetrics(SM_CYFRAME)
   FillRect hdc, tTR, hBr

   ' Draw the caption into the caption area:

   ' top bit under titlebar:
   LSet tTR = tR
   tTR.top = GetSystemMetrics(SM_CXFRAME) + GetSystemMetrics(SM_CYCAPTION) - 1
   tTR.bottom = tTR.top + 1
   FillRect hdc, tTR, hBr
   DeleteObject hBr

   ' Draw the titlebar into a work DC to prevent flicker:
   lFlag = lFlag Or DC_ICON Or DC_TEXT
   LSet tTR = tR
   tTR.left = tTR.left + GetSystemMetrics(SM_CXFRAME)
   tTR.right = tTR.right - GetSystemMetrics(SM_CXFRAME)
   tTR.top = tTR.top + GetSystemMetrics(SM_CYFRAME)
   tTR.bottom = tTR.top + GetSystemMetrics(SM_CYCAPTION) - 1
   LSet tR = tTR
   OffsetRect tR, -tR.left, -tR.top
   LSet tSR = tR
   tSR.right = tSR.right - (tR.bottom - tR.top) * 3 - 2
   DrawCaptionAPI m_hWnd, m_hDC, tSR, lFlag

   ' Draw the titlebar buttons:
   tSR.left = tSR.right
   tSR.right = tR.right
   FillRect m_hDC, tSR, hBrButton
   DeleteObject hBrButton

   InflateRect tR, 0, -2
   tR.right = tR.right - 2
   tR.left = tR.right - (tR.bottom - tR.top) - 2
   DrawFrameControl m_hDC, tR, DFC_CAPTION, DFCS_CAPTIONCLOSE
   OffsetRect tR, -(tR.right - tR.left + 2), 0
   If IsZoomed(m_hWnd) Then
      DrawFrameControl m_hDC, tR, DFC_CAPTION, DFCS_CAPTIONRESTORE
   Else
      DrawFrameControl m_hDC, tR, DFC_CAPTION, DFCS_CAPTIONMAX
   End If
   OffsetRect tR, -(tR.right - tR.left), 0
   DrawFrameControl m_hDC, tR, DFC_CAPTION, DFCS_CAPTIONMIN

   ' Finished drawing the NC area:
   BitBlt hdc, tTR.left, tTR.top, tTR.right - tTR.left, tTR.bottom - tTR.top, m_hDC, 0, 0, vbSrcCopy

   ' Edge 3d
   DrawEdge hdc, tBR, EDGE_RAISED, BF_RECT

End Sub
'===================================================
'
'===================================================
Public Function GetImplementation(iTo As INCAreaModifier) As Boolean
Dim lPtr As Long
   lPtr = GetProp(m_hWnd, "vbalCNCImplementation")
   If Not lPtr = 0 Then
      Dim iToTemp As INCAreaModifier
      CopyMemory iToTemp, lPtr, 4
      Set iTo = iToTemp
      CopyMemory iToTemp, 0&, 4
      GetImplementation = True
   End If
End Function
'===================================================
'
'===================================================
#If 0 = 1 Then
Private Sub pDebugCalcSize(ByRef tNCR As NCCALCSIZE_PARAMS)
Dim i As Long
Dim tWP As WINDOWPOS
   ' Use to show what is happening:
   With tNCR
      For i = 1 To 3
         With .rgrc(i - 1)
            Debug.Print .left, .top, .right, .bottom
         End With
      Next i
      CopyMemory tWP, ByVal .lppos, Len(tWP)
      With tWP
         Debug.Print .x, .y, .x + .cx, .y + .cy
      End With
      
   End With
End Sub
#End If