?? cneocaption.cls
字號:
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -