cneocaption.cls

这是一个有VB开发的学院办公自动化系统

      End If
   End If
   If m_bMinimise Then
      If Not (m_bMouseDownMinimise = bMouseOverMinimise) Then
         If bMouseOverMinimise And bBtnMouseDown And m_bMouseDownMinimise Then
            DrawButton hdc, 2, Down
         Else
            DrawButton hdc, 2, up
         End If
      End If
   End If
   ReleaseDC m_hWnd, hdc
   
End Sub

Private Property Get INCAreaModifier_hWnd() As Long
   INCAreaModifier_hWnd = m_hWnd
End Property


Private Sub INCAreaModifier_InitMenuPopup(ByVal wParam As Long, ByVal lParam As Long)
   ' Set all the menu items to Owner-Draw:
   ' wParam = hMenu
   m_cMenu.OwnerDrawMenu wParam
End Sub

Private Sub INCAreaModifier_NCMouseDown(ByVal x As Long, ByVal y As Long, bHandled As Boolean, ByVal hdc As Long, ByVal lLeft As Long, ByVal lTop As Long, ByVal lRight As Long, ByVal lBottom As Long)
   If m_bClose Then
      If PtInRect(m_tBtn(0), x, y) <> 0 Then
         ' Redraw close button pressed:
         DrawButton hdc, 0, Down
         m_bMouseDownClose = True
         bHandled = True
      End If
   End If
   If m_bMaximise Then
      If PtInRect(m_tBtn(1), x, y) <> 0 Then
         ' Redraw maximise button pressed:
         DrawButton hdc, 1, Down
         m_bMouseDownMaximise = True
         bHandled = True
      End If
   End If
   If m_bMinimise Then
      If PtInRect(m_tBtn(2), x, y) <> 0 Then
         ' Redraw minimise button pressed:
         DrawButton hdc, 2, Down
         m_bMouseDownMinimise = True
         bHandled = True
      End If
   End If

End Sub

Private Sub INCAreaModifier_NCMouseUp(ByVal x As Long, ByVal y As Long, ByVal hdc As Long, ByVal lLeft As Long, ByVal lTop As Long, ByVal lRight As Long, ByVal lBottom As Long)
Dim lStyle As Long
   If m_bClose Then
      If PtInRect(m_tBtn(0), x, y) <> 0 Then
         If m_bMouseDownClose Then
            m_cNCS.SysCommand SC_CLOSE
         End If
      End If
   End If
   If m_bMaximise Then
      If PtInRect(m_tBtn(1), x, y) <> 0 Then
         If m_bMouseDownMaximise Then
            ' Redraw maximise button pressed:
            lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
            If ((lStyle And WS_MAXIMIZE) = WS_MAXIMIZE) Then
               m_cNCS.SysCommand SC_RESTORE
            Else
               m_cNCS.SysCommand SC_MAXIMIZE
            End If
         End If
      End If
   End If
   If m_bMinimise Then
      If PtInRect(m_tBtn(2), x, y) <> 0 Then
         If m_bMouseDownMinimise Then
            m_cNCS.SysCommand SC_MINIMIZE
         End If
      End If
   End If
   DrawButton hdc, 0, up
   DrawButton hdc, 1, up
   DrawButton hdc, 2, up
   
   m_bMouseDownMinimise = False
   m_bMouseDownMaximise = False
   m_bMouseDownClose = False
   
End Sub
Private Sub DrawButton(ByVal hdc As Long, ByVal iIndex As Long, ByVal eState As ECNCButtonStates)
Dim lY As Long
Dim lStyle As Long
   If eState = Down Then
      lY = m_lButtonHeight
   Else
      lY = 0
   End If
   Select Case iIndex
   Case 0
      If m_bClose Then
         BitBlt hdc, m_tBtn(0).left, m_tBtn(0).top, m_lButtonWidth, m_lButtonHeight, m_cCaption.hdc, 241, lY, vbSrcCopy
      End If
   Case 1
      If m_bMaximise Then
         lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
         If ((lStyle And WS_MAXIMIZE) = WS_MAXIMIZE) Then
            BitBlt hdc, m_tBtn(1).left, m_tBtn(1).top, m_lButtonWidth, m_lButtonHeight, m_cCaption.hdc, 240 + m_lButtonWidth, lY, vbSrcCopy
         Else
            BitBlt hdc, m_tBtn(1).left, m_tBtn(1).top, m_lButtonWidth, m_lButtonHeight, m_cCaption.hdc, 240 + m_lButtonWidth * 2, lY, vbSrcCopy
         End If
      End If
   Case 2
      If m_bMinimise Then
         BitBlt hdc, m_tBtn(2).left, m_tBtn(2).top, m_lButtonWidth, m_lButtonHeight, m_cCaption.hdc, 240 + m_lButtonWidth * 3, lY, vbSrcCopy
      End If
   End Select
End Sub

Private Sub INCAreaModifier_NCPaint(ByVal hdc As Long, ByVal lLeft As Long, ByVal lTop As Long, ByVal lRight As Long, ByVal lBottom As Long)
Dim lX As Long, lXE As Long
Dim lY As Long
Dim lW As Long, lH As Long, lRW As Long
Dim lT As Long
Dim lSrcDC As Long, lSrcX As Long, lSrcY As Long
Dim lOrgX As Long
Dim bNoMiddle As Boolean
Dim tR As RECT
Dim sCaption As String
Dim lLen As Long
Dim tLF As LOGFONT
Dim hFnt As Long
Dim hFntOld As Long
Dim lStyle As Long
Dim lhDC As Long, lhDCB As Long
Dim hFntMenu As Long

   LockWindowUpdate hdc
   ' Here we do the work!
   tR.left = lLeft
   tR.top = lTop
   tR.right = lRight
   tR.bottom = lBottom
   
   ' Ensure mem DCs are big enough to draw into:
   m_cFF.Width = tR.right - tR.left + 1
   m_cFF.Height = m_cCaption.Height
   lhDC = m_cFF.hdc
   
   m_cFFB.Width = m_cBorder.Width * 2
   m_cFFB.Height = tR.bottom - tR.top + 1
   lhDCB = m_cFFB.hdc
      
         
   pOLEFontToLogFont m_fnt, hdc, tLF
   If m_cNCS.WindowActive Then
      tLF.lfWeight = FW_BOLD
   End If
   hFnt = CreateFontIndirect(tLF)
   hFntOld = SelectObject(lhDC, hFnt)
  
   If m_cNCS.WindowActive Then
      lOrgX = 0
   Else
      lOrgX = m_lInactiveOffset
   End If
   ' Draw the caption
   BitBlt lhDC, lLeft, lTop, lLeft + m_lActiveLeftEnd, m_cCaption.Height, m_cCaption.hdc, lOrgX, 0, vbSrcCopy
   lRW = (m_lActiveRightEnd - m_lActiveRightStart + 1)
   lXE = lRight - lRW + 1
   If lXE < lLeft + lRW Then
      lXE = lLeft + lRW
      bNoMiddle = True
   End If
   BitBlt lhDC, lXE, lTop, lRW, m_cCaption.Height, m_cCaption.hdc, lOrgX + m_lActiveRightStart, 0, vbSrcCopy
   
   ' Buttons:
   lStyle = GetWindowLong(m_hWnd, GWL_STYLE)
   m_bMaximise = ((lStyle And WS_MAXIMIZEBOX) = WS_MAXIMIZEBOX)
   m_bMinimise = ((lStyle And WS_MINIMIZEBOX) = WS_MINIMIZEBOX)
   m_bClose = ((lStyle And WS_SYSMENU) = WS_SYSMENU)
   m_tBtn(0).left = lXE + lRW - m_cBorder.Height + 4
   If m_bClose Then
      m_tBtn(0).left = m_tBtn(0).left - (m_lButtonWidth + 1)
      m_tBtn(0).top = lTop + 5
      m_tBtn(0).right = m_tBtn(0).left + m_lButtonWidth + 1
      m_tBtn(0).bottom = m_tBtn(0).top + m_lButtonHeight
      DrawButton lhDC, 0, up
   End If
   If m_bMaximise Then
      m_tBtn(1).left = m_tBtn(0).left - (m_lButtonWidth + 1)
      m_tBtn(1).top = lTop + 5
      m_tBtn(1).right = m_tBtn(1).left + m_lButtonWidth + 1
      m_tBtn(1).bottom = m_tBtn(1).top + m_lButtonHeight
      DrawButton lhDC, 1, up
   Else
      m_tBtn(1).left = m_tBtn(0).left
   End If
   If m_bMinimise Then
      m_tBtn(2).left = m_tBtn(1).left - (m_lButtonWidth + 1)
      m_tBtn(2).top = lTop + 5
      m_tBtn(2).right = m_tBtn(2).left + (m_lButtonWidth + 1)
      m_tBtn(2).bottom = m_tBtn(2).top + m_lButtonHeight
      DrawButton lhDC, 2, up
   End If
            
   ' Fill in:
   lX = lLeft + 90
   Do
      lW = 52
      If lX + 52 > lXE Then
         lW = lXE - lX
      End If
      BitBlt lhDC, lX, 0, lW, m_cCaption.Height, m_cCaption.hdc, lOrgX + m_lActiveLeftEnd + 1, 0, vbSrcCopy
      lX = lX + 52
   Loop While lX < lXE
      
   If Not bNoMiddle Then
      
      ' Draw the caption:
      SetBkMode lhDC, TRANSPARENT
      If m_cNCS.WindowActive Then
         SetTextColor lhDC, TranslateColor(m_oActiveCaptionColor)
      Else
         SetTextColor lhDC, TranslateColor(m_oInActiveCaptionColor)
      End If
      lLen = GetWindowTextLength(m_hWnd)
      If lLen > 0 Then
         tR.left = lLeft + 92
         tR.right = lRight - 96
         tR.top = m_cBorder.Height + 1
         tR.bottom = tR.top + (m_cCaption.Height - m_cBorder.Height - 2) \ 2
         sCaption = String$(lLen + 1, 0)
         GetWindowText m_hWnd, sCaption, lLen + 1
         DrawText lhDC, sCaption, -1, tR, DT_LEFT Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_NOPREFIX
      End If
      
   End If
   
   ' Menu:
   m_cMenu.hMenu = m_cNCS.hMenu
   lW = lXE - m_lActiveLeftEnd
   tLF.lfWeight = FW_NORMAL
   hFntMenu = CreateFontIndirect(tLF)
   m_cMenu.Render hFntMenu, lhDC, m_lActiveLeftEnd, m_cCaption.Height \ 2, lW, m_cCaption.Height \ 2, -m_cCaption.Height \ 2 + 2
   DeleteObject hFntMenu
   
   BitBlt hdc, 0, 0, m_cFF.Width, m_cFF.Height, lhDC, 0, 0, vbSrcCopy
   
   
   ' Draw the border:
   lY = m_cCaption.Height
   lH = m_cBorder.Height
   lW = lH
   lSrcDC = m_cBorder.hdc
   lSrcX = lW * 4
   lSrcY = 0
   ' We draw double the amount each time for a quick finish:
   Do
      ' Draw to lhs:
      BitBlt lhDCB, 0, lY + lTop, lW, lH, lSrcDC, 0, lSrcY, vbSrcCopy
      ' Draw to right:
      BitBlt lhDCB, lW, lY + lTop, lW, lH, lSrcDC, lSrcX, lSrcY, vbSrcCopy
      'Exit Do
      If lSrcY = 0 Then
         lSrcDC = lhDCB
         lSrcY = lY + lTop
         lSrcX = lW
         lY = lY + lH
      Else
         lY = lY + lH
         lH = lH * 2
      End If
   Loop While lY < lBottom - lW
   lT = m_cCaption.Height + lTop
   lH = lBottom - lT
   BitBlt hdc, lLeft, lT, lW, lH, lhDCB, 0, lT, vbSrcCopy
   BitBlt hdc, lRight - lW, lT, lW, lH, lhDCB, lW, lT, vbSrcCopy
   
   lT = lBottom - lW
   If lT < m_cCaption.Height Then
      lT = m_cCaption.Height
   End If
   
   ' Bottom - we draw into the caption mem dc for flicker free
   lX = lLeft + lW
   lH = m_cBorder.Height
   lSrcDC = m_cBorder.hdc
   lSrcX = lW * 3
   lSrcY = 0
   ' We draw double the amount each time for a quick finish:
   Do
      BitBlt lhDC, lX, 0, lW, lH, lSrcDC, lSrcX, lSrcY, vbSrcCopy
      If lSrcY = 0 Then
         lSrcDC = lhDC
         lSrcX = lX
         lX = lX + lW
      Else
         lX = lX + lW
         lW = lW * 2
      End If
   Loop While lX < lRight - lH
   ' Bottom corners
   BitBlt lhDC, lLeft, 0, lH, lH, m_cBorder.hdc, lH * 2, 0, vbSrcCopy
   BitBlt lhDC, lRight - lH, 0, lH, lH, m_cBorder.hdc, lH * 6, 0, vbSrcCopy
   
   ' Swap out to display:
   BitBlt hdc, lLeft, lT, m_cFF.Width, lH, lhDC, 0, 0, vbSrcCopy
  
   SelectObject lhDC, hFntOld
   DeleteObject hFnt
    LockWindowUpdate 0
End Sub

Private Sub INCAreaModifier_GetBottomMarginHeight(cy As Long)
  '
  cy = m_cBorder.Height
End Sub

Private Sub INCAreaModifier_GetLeftMarginWidth(cx As Long)
   '
   cx = m_cBorder.Height
End Sub

Private Sub INCAreaModifier_GetRightMarginWidth(cx As Long)
   '
   cx = m_cBorder.Height
End Sub

Private Sub INCAreaModifier_GetTopMarginHeight(cy As Long)
   '
   cy = m_cCaption.Height
End Sub

' Convert Automation color to Windows color
Private Function TranslateColor(ByVal clr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function


Private Sub pOLEFontToLogFont(fntThis As StdFont, ByVal hdc As Long, tLF As LOGFONT)
Dim sFont As String
Dim iChar As Integer
Dim b() As Byte

   ' Convert an OLE StdFont to a LOGFONT structure:
   With tLF
     sFont = fntThis.Name
     b = StrConv(sFont, vbFromUnicode)
     For iChar = 1 To Len(sFont)
       .lfFaceName(iChar - 1) = b(iChar - 1)
     Next iChar
     ' Based on the Win32SDK documentation:
     .lfHeight = -MulDiv((fntThis.Size), (GetDeviceCaps(hdc, LOGPIXELSY)), 72)
     .lfItalic = fntThis.Italic
     If (fntThis.Bold) Then
       .lfWeight = FW_BOLD
     Else
       .lfWeight = FW_NORMAL
     End If
     .lfUnderline = fntThis.Underline
     .lfStrikeOut = fntThis.Strikethrough
     .lfCharSet = fntThis.Charset
   End With

End Sub