cnccalcsize.cls

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

   ReleaseCapture
   SendMessage m_hWnd, WM_NCLBUTTONDOWN, HTCAPTION, tPS
End Sub
'===================================================
'
'===================================================
Public Sub SysCommand(ByVal eCmd As ECNCSysCommandConstants)
    PostMessage m_hWnd, WM_SYSCOMMAND, eCmd, 0
End Sub
'===================================================
'
'===================================================
Public Sub Attach(ByVal iTo As INCAreaModifier)
   Dim lhDC As Long
   
   Detach
   
   m_hWnd = iTo.hwnd
   m_hMenu = GetMenu(m_hWnd)
   
   m_bIsMDIChild = IsMDIChildForm(m_hWnd)
   
   ' Allows us to remove menu bar, caption etc:
   AttachMessage Me, m_hWnd, WM_NCCALCSIZE
   ' Handle drawing borders, caption etc ourselves:
   AttachMessage Me, m_hWnd, WM_NCPAINT
   ' Win redraws caption during NCACTIVATE:
   AttachMessage Me, m_hWnd, WM_NCACTIVATE
   ' On NC Button Down, Win redraws the min/max/close buttons:
   AttachMessage Me, m_hWnd, WM_NCLBUTTONDOWN
   ' Check for button up so we can notify client:
   AttachMessage Me, m_hWnd, WM_NCLBUTTONUP
   ' on NC double click, Win redraws the min/max/close buttons:
   AttachMessage Me, m_hWnd, WM_NCLBUTTONDBLCLK
   ' Allows us to use the default implementations
   ' for hittest events:
   AttachMessage Me, m_hWnd, WM_NCHITTEST
   ' Hack:
   AttachMessage Me, m_hWnd, WM_SETCURSOR
   ' On SysMenu Show, Win redraws the min/max/close buttons:
   AttachMessage Me, m_hWnd, WM_INITMENU
   AttachMessage Me, m_hWnd, WM_INITMENUPOPUP
   ' On ChangeStyle, Win redraws the entire caption:
   AttachMessage Me, m_hWnd, WM_STYLECHANGED
   ' On SetText, Win redraws the entire caption:
   AttachMessage Me, m_hWnd, WM_SETTEXT
   ' Checking for activateapp:
   AttachMessage Me, m_hWnd, WM_ACTIVATEAPP
   ' EnterMenuLoop
   AttachMessage Me, m_hWnd, WM_ENTERMENULOOP
   ' ExitMenuLoop
   AttachMessage Me, m_hWnd, WM_EXITMENULOOP
   
   If m_bIsMDIChild Then
      AttachMessage Me, m_hWnd, WM_SIZE
   End If
   
   ' So we can automatically detach ourselves when the parent closes:
   AttachMessage Me, m_hWnd, WM_DESTROY
   
   
   lhDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
   m_hDC = CreateCompatibleDC(lhDC)
   m_hBmp = CreateCompatibleBitmap(lhDC, Screen.Width \ Screen.TwipsPerPixelX, GetSystemMetrics(SM_CYCAPTION) * 4)
   DeleteDC lhDC
   m_hBmpOld = SelectObject(m_hDC, m_hBmp)
   
   m_hWndMDIClient = FindWindowEx(m_hWnd, 0, "MDIClient", ByVal 0&)
      
   SetProp m_hWnd, "vbalCNCImplementation", ObjPtr(iTo)
   
   AttachKeyboardHook Me
End Sub
'===================================================
'
'===================================================
Public Property Get hMenu() As Long
   hMenu = m_hMenu
End Property
'===================================================
'
'===================================================
Public Sub Detach()
   DetachKeyboardHook Me
   If m_hWnd <> 0 Then
      DetachMessage Me, m_hWnd, WM_NCCALCSIZE
      DetachMessage Me, m_hWnd, WM_NCPAINT
      DetachMessage Me, m_hWnd, WM_NCACTIVATE
      DetachMessage Me, m_hWnd, WM_NCLBUTTONDOWN
      DetachMessage Me, m_hWnd, WM_NCLBUTTONUP
      DetachMessage Me, m_hWnd, WM_NCLBUTTONDBLCLK
      DetachMessage Me, m_hWnd, WM_NCHITTEST
      
      DetachMessage Me, m_hWnd, WM_SETCURSOR
      
      DetachMessage Me, m_hWnd, WM_INITMENU
      DetachMessage Me, m_hWnd, WM_INITMENUPOPUP
      
      DetachMessage Me, m_hWnd, WM_STYLECHANGED
      DetachMessage Me, m_hWnd, WM_SETTEXT
      
      DetachMessage Me, m_hWnd, WM_ACTIVATEAPP
      
      DetachMessage Me, m_hWnd, WM_ENTERMENULOOP
      DetachMessage Me, m_hWnd, WM_EXITMENULOOP
      
      If m_bIsMDIChild Then
         DetachMessage Me, m_hWnd, WM_SIZE
         m_bIsMDIChild = False
      End If
      
      DetachMessage Me, m_hWnd, WM_DESTROY
   End If
   If m_hDC <> 0 Then
      If m_hBmpOld <> 0 Then
         SelectObject m_hDC, m_hBmp
         m_hBmpOld = 0
      End If
      If m_hBmp <> 0 Then
         DeleteObject m_hBmp
         m_hBmp = 0
      End If
      If m_hDC <> 0 Then
         DeleteDC m_hDC
         m_hDC = 0
      End If
   End If
   RemoveProp m_hWnd, "vbalCNCImplementation"
   m_hWnd = 0
   m_hWndMDIClient = 0
   m_hMenu = 0
End Sub
'===================================================
'
'===================================================
Friend Function AltKeyAccelerator(ByVal vKey As KeyCodeConstants) As Long
Dim Implementation As INCAreaModifier
   If GetImplementation(Implementation) Then
      AltKeyAccelerator = Implementation.AltKeyAccelerator(vKey)
   End If
End Function
'===================================================
'
'===================================================
Private Sub pShowMDIButtons(ByVal hwnd As Long, ByVal bState As Boolean)
   m_bState = bState
End Sub
'===================================================
'
'===================================================
Private Sub MyMoveWindow()
Dim tPInit As POINTAPI
Dim tPLast As POINTAPI
Dim tP As POINTAPI
Dim tR As RECT
Dim hWndParent As Long
Dim tWRInit As RECT
Dim dx As Long, dy As Long
      
   GetWindowRect m_hWnd, tR
   hWndParent = GetParent(m_hWnd)
   If Not hWndParent = 0 Then
      MapWindowPoints HWND_DESKTOP, hWndParent, tR, 2
   End If
   GetCursorPos tPInit
   LSet tPLast = tPInit
   Do While Not (GetAsyncKeyState(vbLeftButton) = 0) And m_bActive
      GetCursorPos tP
      If tP.x <> tPLast.x Or tP.y <> tPLast.y Then
         ' Moved:
         dx = tP.x - tPLast.x
         dy = tP.y - tPLast.y
         SetWindowPos m_hWnd, 0, tR.left + dx, tR.top + dy, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOOWNERZORDER
         LSet tPLast = tP
         GetWindowRect m_hWnd, tR
         If Not hWndParent = 0 Then
            MapWindowPoints HWND_DESKTOP, hWndParent, tR, 2
         End If
      End If
      DoEvents
      Sleep 1
   Loop
   
End Sub
'===================================================
'
'===================================================
Private Sub Class_Terminate()
   Detach
End Sub
'===================================================
'
'===================================================
Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
   '
End Property
'===================================================
'
'===================================================
Private Property Get ISubclass_MsgResponse() As EMsgResponse
   
   Select Case CurrentMessage
   Case WM_NCPAINT, WM_NCLBUTTONDOWN, _
         WM_NCLBUTTONDBLCLK, _
         WM_INITMENUPOPUP, WM_INITMENU, _
         WM_SETCURSOR, WM_CHILDACTIVATE, _
         WM_STYLECHANGED, WM_SETTEXT, _
         WM_NCHITTEST, WM_SIZE, _
         WM_ENTERMENULOOP, WM_EXITMENULOOP
      ISubclass_MsgResponse = emrConsume
   Case Else
      ' ActiveApp, Destroy:
      ISubclass_MsgResponse = emrPreprocess
   End Select
   
End Property
'===================================================
'
'===================================================
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNCR As NCCALCSIZE_PARAMS
Dim tWP As WINDOWPOS
Dim tP As POINTAPI
Dim tR As RECT
Dim lhWnd As Long
Dim lpfMaximised As Long
Dim lPtr As Long
Dim hdc As Long
Dim lStyle As Long
Dim eHt As ECNCHitTestConstants
Static s_dx As Long
Static s_dy As Long
Dim bCanSize As Boolean
Dim Implementation As INCAreaModifier
Dim bHandled As Boolean
Static s_bNoStyleChangeProcessing As Boolean
Static s_bChildActivate As Boolean

   Select Case iMsg
   
   Case WM_DESTROY
      ' Goodbye!
      Detach
   
   Case WM_NCPAINT
      
      ' Due to processing elsewhere in this subclass, we
      ' might inadvertently be drawing when the window
      ' is being closed or invisible.  Check before
      ' drawing:
      If Not (IsWindowVisible(hwnd) = 0) Then
         m_bZoomedMDIChild = (IsMDIChildForm(hwnd) And (IsZoomed(hwnd) <> 0))
         If m_bZoomedMDIChild Then
            ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
         Else
            ' Get the non-client DC to draw in:
            hdc = GetWindowDC(m_hWnd)
                        
            GetWindowRect m_hWnd, tR
            OffsetRect tR, -tR.left, -tR.top
                     
            If GetImplementation(Implementation) Then
               Implementation.NCPaint hdc, tR.left, tR.top, tR.right, tR.bottom
            Else
               DefaultNCPaint hdc, tR.left, tR.top, tR.right, tR.bottom
            End If
            
            ReleaseDC m_hWnd, hdc
         End If
      End If
         
   Case WM_NCHITTEST
      
      If GetImplementation(Implementation) Then
         eHt = pGetHitTestCode()
         m_eLastHT = eHt
         If eHt = HTMENU Then
            ' Cannot allow windows to have this; if you
            ' mouse down on menu or caption then windows
            ' redraws the caption on top...
            ISubclass_WindowProc = HTCLIENT
         Else
            ISubclass_WindowProc = eHt
         End If
         
      Else
         ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      End If
      
   Case WM_NCLBUTTONDOWN
      '
      ' a hack.
      '
      ' Win suspends when we do a NC Button down.  It also
      ' redraws the min/max/close buttons. We can force them
      ' to go away by moving the mouse
      '
      If s_dx = 0 Then s_dx = 1
      If s_dy = 0 Then s_dy = 1
      s_dx = -1 * s_dx: s_dy = -1 * s_dy
      mouse_event MOUSEEVENTF_MOVE, s_dx, s_dy, 0, 0
      
      ' We cannot allow Windows to do the default HTCAPTION action,
      ' because it redraws the caption during the move.  THerefore
      ' swallow HTCAPTION events and reimplement window moving
      ' ourselves:
      wParam = pGetHitTestCode()
      If GetImplementation(Implementation) Then
         If m_bActive Then
            If m_eLastHT = HTCAPTION Then
               MyMoveWindow
               Exit Function
            End If
         Else
            If m_eLastHT = HTCAPTION Then
               SetForegroundWindow m_hWnd
               MyMoveWindow
               Exit Function
            End If
         End If
         
         GetCursorPos tP
         GetWindowRect m_hWnd, tR
         tP.x = tP.x - tR.left: tP.y = tP.y - tR.top
         OffsetRect tR, -tR.left, -tR.top
         hdc = GetWindowDC(m_hWnd)
         Implementation.NCMouseDown tP.x, tP.y, bHandled, hdc, tR.left, tR.top, tR.right, tR.bottom
         ReleaseDC m_hWnd, hdc
         If bHandled Then
            Exit Function
         End If
                  
      End If
      
      ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
   
   Case WM_NCLBUTTONUP
      If GetImplementation(Implementation) Then
         GetCursorPos tP
         GetWindowRect m_hWnd, tR
         tP.x = tP.x - tR.left: tP.y = tP.y - tR.top
         OffsetRect tR, -tR.left, -tR.top
         hdc = GetWindowDC(m_hWnd)
         Implementation.NCMouseDown tP.x, tP.y, bHandled, hdc, tR.left, tR.top, tR.right, tR.bottom
         ReleaseDC m_hWnd, hdc
         Implementation.NCMouseUp tP.x, tP.y, hdc, tR.left, tR.top, tR.right, tR.bottom
      End If
         
   Case WM_SETCURSOR
      '
      ' a Very Nasty Hack :)
      ' discovered by watching NeoPlanet and MSOffice
      ' in Spy++
      '
      ' Without this, Win will redraw caption areas and
      ' min/max/close buttons whenever the mouse is released
      ' following a NC mouse down.
      '
      s_bNoStyleChangeProcessing = True
      lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
      SetWindowLong m_hWnd, GWL_STYLE, lStyle And Not WS_VISIBLE
      ISubclass_WindowProc = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      If GetMenu(m_hWnd) <> 0 Then
         SetMenu m_hWnd, 0
      End If
      SetWindowLong m_hWnd, GWL_STYLE, lStyle
      s_bNoStyleChangeProcessing = False
   
   Case WM_INITMENU
      ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)
      ISubclass_WindowProc hwnd, WM_NCPAINT, 0, 0
      
   Case WM_CHILDACTIVATE
      If Not s_bChildActivate Then
         s_bChildActivate = True
         ISubclass_MsgResponse = CallOldWindowProc(hwnd, iMsg, wParam, lParam)