cxpmenu.cls

VB下开发Windows XP风格的控件

    With SetRect
        .Left = Left
        .Top = Top
        .Right = Right
        .Bottom = Bottom
    End With 'SETRECT

End Function

Private Sub PrintText(ByVal crColor As Long, Optional ByVal bEnable As Boolean)

  Dim TextRect(0 To 2) As RECT
  Dim szTmp As String, szAcce As String
  Dim m_size As Size
  Dim pt As POINTAPI, ms As Size

    SetBkMode m_DrawStruct.hDC, NEWTRANSPARENT
    If bEnable Then
        SetTextColor m_DrawItem.hDC, crColor
      Else 'BENABLE = FALSE
        SetTextColor m_DrawItem.hDC, RGB(160, 160, 160)
    End If

    szTmp = Caption

    '    Dim lUnderLine As Long
    '    Dim i As Long

    '    i = InStr(szTmp, "&")
    '    Do While i <> 0 And i <> Len(szTmp)
    '        If Mid(szTmp, i + 1, 1) <> "&" Then
    '            lUnderLine = i
    '            szTmp = Left(szTmp, i - 1) + Mid(szTmp, i + 1)
    '            Exit Do
    '            Debug.Print szTmp
    '        End If
    '        i = InStr(i + 1, szTmp, "&")
    '    Loop

    If InStr(szTmp, vbTab) <> 0 Then
        szAcce = Mid(szTmp, InStr(szTmp, vbTab) + 1)
        szTmp = Left(szTmp, InStr(szTmp, vbTab) - 1)
        GetTextExtentPoint32 m_DrawItem.hDC, szAcce, lstrlen(szAcce), m_size
    End If

    GetTextExtentPoint32 m_DrawItem.hDC, "M", 1, ms
    TextRect(0) = SetRect(m_DrawItem.rcItem.Left + PicWidth + 4, m_DrawItem.rcItem.Top + 3, m_DrawItem.rcItem.Left + PicWidth + 4 + lstrlen(szTmp) * 6, m_DrawItem.rcItem.Top + 15)
    TextRect(1) = SetRect(m_DrawItem.rcItem.Right - m_size.cx - 4, m_DrawItem.rcItem.Top + 3, m_DrawItem.rcItem.Right - m_size.cx - 4 + lstrlen(szAcce) * 6, m_DrawItem.rcItem.Top + 15)
    TextRect(2) = SetRect(m_DrawItem.rcItem.Left + PicToText, m_DrawItem.rcItem.Top + 3, m_DrawItem.rcItem.Left + PicToText + lstrlen(szTmp) * 6, m_DrawItem.rcItem.Top + 15)
    If Depth <> 0 Then
        DrawText m_DrawStruct.hDC, szTmp, lstrlen(szTmp), TextRect(0), DT_NOCLIP Or DT_SINGLELINE Or DT_VCENTER
        '        If lUnderLine <> 0 Then
        '            MoveToEx m_DrawStruct.hdc, m_DrawItem.rcItem.Left + PicWidth + 4 + ms.cX * (lstrlen(Left(szTmp, lUnderLine - 1))), m_DrawItem.rcItem.Top + 3 + ms.cY, pt
        '            LineTo m_DrawStruct.hdc, m_DrawItem.rcItem.Left + PicWidth + 4 + ms.cX * (lstrlen(Left(szTmp, lUnderLine))), m_DrawItem.rcItem.Top + 3 + ms.cY
        '        End If
        DrawText m_DrawStruct.hDC, szAcce, lstrlen(szAcce), TextRect(1), DT_NOCLIP Or DT_SINGLELINE Or DT_VCENTER
      Else 'NOT DEPTH...
        DrawText m_DrawStruct.hDC, szTmp, lstrlen(szTmp), TextRect(2), DT_NOCLIP Or DT_SINGLELINE Or DT_VCENTER
        '       If lUnderLine <> 0 Then
        '           MoveToEx m_DrawStruct.hdc, m_DrawItem.rcItem.Left + PicToText + ms.cX * (lstrlen(Left(szTmp, lUnderLine - 1))), m_DrawItem.rcItem.Top + 3 + ms.cY, pt
        '           LineTo m_DrawStruct.hdc, m_DrawItem.rcItem.Left + PicToText + ms.cX * (lstrlen(Left(szTmp, lUnderLine))), m_DrawItem.rcItem.Top + 3 + ms.cY
        '       End If
    End If

    'i=instr(

End Sub

Public Sub DrawMenu()

  Dim hSelectedItem As Long, crSelectedItem As Long, hMenuColor As Long, hRightBar As Long, hLeftBar As Long
  Dim hSperateLinePen As Long, i As Long, hCheckPen As Long
  Dim hGDIBackup As Long
  Dim pt As POINTAPI
  Dim bDisabled As Boolean
  Dim bChecked As Boolean
  Dim Draw_Rect As RECT
  Dim rt As RECT, rt1 As RECT
  Dim szTmp As String
  Dim hMenuWnd As Long
  Dim hRGN As Long, hOldRgn As Long
  Dim vert(1) As TRIVERTEX
  Dim gRect As GRADIENT_RECT

    m_DrawItem = m_DrawStruct

    hMenuWnd = WindowFromDC(m_DrawItem.hDC)
    szTmp = Space(100)
    GetClassName hMenuWnd, szTmp, 100

    GetWindowRect hMenuWnd, rt

    Draw_Rect = m_DrawItem.rcItem
    bDisabled = (GetMenuState(hParentMenu, MenuId, 0) And MF_DISABLED) Or (GetMenuState(hParentMenu, MenuId, 0) And MF_GRAYED)
    bChecked = GetMenuState(hParentMenu, MenuId, 0) And MF_CHECKED

    If Depth <> 0 Then
        Draw_Rect.Left = Draw_Rect.Left + (PicWidth + PicToText) - 4
      Else 'NOT DEPTH...
        Draw_Rect.Left = Draw_Rect.Left + 2
    End If

    hSelectedItem = CreateSolidBrush(SelBackColor)
    hMenuColor = CreateSolidBrush(GetSysColor(COLOR_MENU))
    hLeftBar = CreateSolidBrush(&HE0E0E0)
    hRightBar = CreateSolidBrush(&HF7F7F7)

    hSperateLinePen = CreatePen(PS_SOLID, 1, &HC7C7C7)
    hCheckPen = CreatePen(PS_SOLID, 1, &HC08080)

    If (m_DrawItem.ItemState And ODS_SELECTED) Or (m_DrawItem.ItemState And ODS_HOTLIGHT) Then
        Select Case m_Style
          Case 1
            hGDIBackup = SelectObject(m_DrawItem.hDC, hSelectedItem)
            Rectangle m_DrawItem.hDC, m_DrawItem.rcItem.Left, m_DrawItem.rcItem.Top, m_DrawItem.rcItem.Right, m_DrawItem.rcItem.Bottom
            SelectObject m_DrawItem.hDC, hGDIBackup
          Case 2
            With vert(0)
                .X = m_DrawItem.rcItem.Left
                .Y = m_DrawItem.rcItem.Top
                .Red = m_LR
                .Green = m_LG
                .Blue = m_LB
                .Alpha = 0
            End With 'VERT(0)
            With vert(1)
                .X = m_DrawItem.rcItem.Right
                .Y = m_DrawItem.rcItem.Bottom
                .Red = m_RR
                .Green = m_RG
                .Blue = m_RB
                .Alpha = 0
            End With 'VERT(1)
            gRect.UpperLeft = 0
            gRect.LowerRight = 1
            GradientFillRect m_DrawItem.hDC, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H

        End Select
      Else 'NOT (M_DRAWITEM.ITEMSTATE...
        Draw_Rect = m_DrawItem.rcItem
        FillRect m_DrawItem.hDC, Draw_Rect, hMenuColor

        Draw_Rect.Right = Draw_Rect.Left + PicWidth
        FillRect m_DrawItem.hDC, Draw_Rect, hLeftBar

        Draw_Rect = m_DrawItem.rcItem
        Draw_Rect.Left = Draw_Rect.Left + PicWidth
        FillRect m_DrawItem.hDC, Draw_Rect, IIf(Depth = 0, hLeftBar, hRightBar)
    End If

    If Depth <> 0 Then
        If Caption <> "" Then
            Select Case m_Style
              Case 1
                PrintText vbBlack, Not bDisabled
              Case 2
                If (m_DrawItem.ItemState And ODS_SELECTED) Or (m_DrawItem.ItemState And ODS_HOTLIGHT) Then
                    PrintText vbWhite, Not bDisabled
                  Else 'NOT (M_DRAWITEM.ITEMSTATE...
                    PrintText vbBlack, Not bDisabled
                End If
            End Select
          Else 'NOT CAPTION...
            MoveToEx m_DrawItem.hDC, m_DrawItem.rcItem.Left + PicWidth + 4, m_DrawItem.rcItem.Top + (m_DrawItem.rcItem.Bottom - m_DrawItem.rcItem.Top) / 2, pt 'ByVal 0
            hGDIBackup = SelectObject(m_DrawItem.hDC, hSperateLinePen)
            LineTo m_DrawItem.hDC, m_DrawItem.rcItem.Right - 4, m_DrawItem.rcItem.Top + (m_DrawItem.rcItem.Bottom - m_DrawItem.rcItem.Top) / 2
            SelectObject m_DrawItem.hDC, hGDIBackup
        End If

        If bChecked Then
            hGDIBackup = SelectObject(m_DrawItem.hDC, hCheckPen)
            Draw_Rect = m_DrawItem.rcItem
            Draw_Rect.Right = Draw_Rect.Left + PicWidth

            MoveToEx m_DrawItem.hDC, Draw_Rect.Left + 3, Draw_Rect.Top + (Draw_Rect.Bottom - Draw_Rect.Top) / 2 - 1, pt ' 0
            LineTo m_DrawItem.hDC, Draw_Rect.Left + (Draw_Rect.Right - Draw_Rect.Left) / 2 - 2, Draw_Rect.Bottom - 6
            LineTo m_DrawItem.hDC, (Draw_Rect.Right - 2), Draw_Rect.Top + 5

            MoveToEx m_DrawItem.hDC, Draw_Rect.Left + 4, Draw_Rect.Top + (Draw_Rect.Bottom - Draw_Rect.Top) / 2 - 1, pt '0
            LineTo m_DrawItem.hDC, Draw_Rect.Left + (Draw_Rect.Right - Draw_Rect.Left) / 2 - 1, Draw_Rect.Bottom - 6
            LineTo m_DrawItem.hDC, (Draw_Rect.Right - 2), Draw_Rect.Top + 4

            SelectObject m_DrawItem.hDC, hGDIBackup
        End If
      Else 'NOT DEPTH...
        If Caption <> "=" Then
            Select Case m_Style
              Case 1
                PrintText vbBlack, Not bDisabled
              Case 2
                If (m_DrawItem.ItemState And ODS_SELECTED) Or (m_DrawItem.ItemState And ODS_HOTLIGHT) Then
                    PrintText vbWhite, Not bDisabled
                  Else 'NOT (M_DRAWITEM.ITEMSTATE...
                    PrintText vbBlack, Not bDisabled
                End If
            End Select
          Else 'NOT CAPTION...
            hGDIBackup = SelectObject(m_DrawItem.hDC, hSperateLinePen)
            For i = m_DrawItem.rcItem.Top + 2 To m_DrawItem.rcItem.Bottom Step 2
                MoveToEx m_DrawItem.hDC, m_DrawItem.rcItem.Left + 5, i, pt
                LineTo m_DrawItem.hDC, m_DrawItem.rcItem.Left + 5 + 5, i
            Next i
            SelectObject m_DrawItem.hDC, hGDIBackup
        End If
    End If

    DeleteObject hCheckPen
    DeleteObject hRightBar
    DeleteObject hSelectedItem
    DeleteObject hMenuColor
    DeleteObject hLeftBar
    DeleteObject hSperateLinePen

End Sub

':) Ulli's VB Code Formatter V2.10.8 (2003-01-03 10:12:30) 120 + 300 = 420 Lines