command button.ctl

仿xp的计算器功能和普通计算器的功能一样

    With UserControl
        .AutoRedraw = True
        .Cls
        .ScaleMode = 3
        hBrush = CreateSolidBrush(RGB(245, 244, 234))
        FillRect .Hdc, rc, hBrush
        DeleteObject hBrush
        hBrush = CreateSolidBrush(RGB(201, 199, 186))
        FrameRect .Hdc, rc, hBrush
        DeleteObject hBrush
        'Left top corner
        SetPixel .Hdc, L, t + 1, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, t + 1, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, t, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, t + 2, RGB(234, 233, 222)
        SetPixel .Hdc, L + 2, t + 1, RGB(234, 233, 222)
        'right top corner
        SetPixel .Hdc, R - 1, t, RGB(216, 213, 199)
        SetPixel .Hdc, R - 1, t + 1, RGB(216, 213, 199)
        SetPixel .Hdc, R, t + 1, RGB(216, 213, 199)
        SetPixel .Hdc, R - 2, t + 1, RGB(234, 233, 222)
        SetPixel .Hdc, R - 1, t + 2, RGB(234, 233, 222)
        'left bottom corner
        SetPixel .Hdc, L, B - 2, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, B - 2, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, B - 1, RGB(216, 213, 199)
        SetPixel .Hdc, L + 1, B - 3, RGB(234, 233, 222)
        SetPixel .Hdc, L + 2, B - 2, RGB(234, 233, 222)
        'right bottom corner
        SetPixel .Hdc, R, B - 2, RGB(216, 213, 199)
        SetPixel .Hdc, R - 1, B - 2, RGB(216, 213, 199)
        SetPixel .Hdc, R - 1, B - 1, RGB(216, 213, 199)
        SetPixel .Hdc, R - 1, B - 3, RGB(234, 233, 222)
        SetPixel .Hdc, R - 2, B - 2, RGB(234, 233, 222)
    End With 'USERCONTROL

End Sub

Private Sub DrawButtonDown()

'<:-) :WARNING: Large Code procedure (54 lines of code)
'<:-) It is recommended that you try to break it into smaller procedures

Dim pt     As POINTAPI
Dim Pen    As Long
Dim hPen   As Long
Dim I      As Long
Dim ColorR As Long
Dim ColorG As Long
Dim ColorB As Long

    With UserControl
        .AutoRedraw = True
        .Cls
        .ScaleMode = 3
        'draw gradient
        ColorR = 226
        ColorG = 225
        ColorB = 218
        For I = t + 3 To B - 2 Step 4
            hPen = CreatePen(PS_SOLID, 4, RGB(ColorR, ColorG, ColorB))
            Pen = SelectObject(.Hdc, hPen)
            MoveToEx .Hdc, L, I, pt
            LineTo .Hdc, R, I
            SelectObject .Hdc, Pen
            DeleteObject hPen
            If ColorB >= 218 Then
                ColorR = ColorR - 1
                ColorG = ColorG - 1
                ColorB = ColorB - 1
            End If
        Next I
        'top shadow
        hPen = CreatePen(PS_SOLID, 1, RGB(209, 204, 192))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, t + 1, pt
        LineTo .Hdc, R, t + 1
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(220, 216, 207))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, t + 2, pt
        LineTo .Hdc, R, t + 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
        'bottom shadow
        hPen = CreatePen(PS_SOLID, 1, RGB(234, 233, 227))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, B - 3, pt
        LineTo .Hdc, R, B - 3
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(242, 241, 238))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, B - 2, pt
        LineTo .Hdc, R, B - 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
    End With 'USERCONTROL

End Sub

Private Sub DrawButtonFace()

Dim pt     As POINTAPI
Dim Pen    As Long
Dim hPen   As Long
Dim I      As Long
Dim ColorR As Long
Dim ColorG As Long
Dim ColorB As Long

    With UserControl
        .AutoRedraw = True
        .Cls
        .ScaleMode = 3
        'draw gradient
        ColorR = 255
        ColorG = 255
        ColorB = 253
        For I = t + 3 To B - 3 Step 1
            hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
            Pen = SelectObject(.Hdc, hPen)
            MoveToEx .Hdc, L, I, pt
            LineTo .Hdc, R, I
            SelectObject .Hdc, Pen
            DeleteObject hPen
            If ColorB >= 230 Then
                ColorR = ColorR - 1
                ColorG = ColorG - 1
                ColorB = ColorB - 1
            End If
        Next I
        'bottom shadow
        hPen = CreatePen(PS_SOLID, 1, RGB(214, 208, 197))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, B - 2, pt
        LineTo .Hdc, R, B - 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(226, 223, 214))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, B - 3, pt
        LineTo .Hdc, R, B - 3
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(236, 235, 230))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L, B - 4, pt
        LineTo .Hdc, R, B - 4
        SelectObject .Hdc, Pen
        DeleteObject hPen
    End With 'USERCONTROL

End Sub

Private Sub DrawCaption()

Dim vh    As Long
Dim rcTxt As RECT

    With UserControl
        GetClientRect .hwnd, rcTxt
        If mEnabled Then
            If isOver Then
                SetTextColor .Hdc, mForeHover
            Else 'ISOVER = FALSE/0
                SetTextColor .Hdc, .ForeColor
            End If
        Else 'MENABLED = FALSE/0
            SetTextColor .Hdc, RGB(161, 161, 146)
        End If
        vh = DrawText(.Hdc, mCaption, Len(mCaption), rcTxt, DT_CALCRECT Or DT_CENTER Or DT_WORDBREAK)
        'If Button = 1 Then
        '  SetRect rcTxt, 0, (.ScaleHeight * 0.5) - (vh * 0.5) + 1, .ScaleWidth, (.ScaleHeight * 0.5) + (vh * 0.5) + 1
        '  DrawText .hdc, mCaption, Len(mCaption), rcTxt, DT_CENTER Or DT_WORDBREAK
        'Else
        SetRect rcTxt, 0, (.ScaleHeight * 0.5) - (vh * 0.5), .ScaleWidth, (.ScaleHeight * 0.5) + (vh * 0.5)
        DrawText .Hdc, mCaption, Len(mCaption), rcTxt, DT_CENTER Or DT_WORDBREAK
        'End If
    End With 'USERCONTROL

End Sub

Private Sub DrawFocus()

'<:-) :WARNING: Large Code procedure (55 lines of code)
'<:-) It is recommended that you try to break it into smaller procedures

Dim pt     As POINTAPI
Dim Pen    As Long
Dim hPen   As Long
Dim I      As Long
Dim ColorR As Long
Dim ColorG As Long
Dim ColorB As Long

    With UserControl
        'top line
        hPen = CreatePen(PS_SOLID, 1, RGB(206, 231, 251))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 2, t + 1, pt
        LineTo .Hdc, R - 1, t + 1
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(188, 212, 246))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 1, t + 2, pt
        LineTo .Hdc, R, t + 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
        'draw gradient
        ColorR = 186
        ColorG = 211
        ColorB = 246
        For I = t + 3 To B - 4 Step 1
            hPen = CreatePen(PS_SOLID, 2, RGB(ColorR, ColorG, ColorB))
            Pen = SelectObject(.Hdc, hPen)
            MoveToEx .Hdc, L + 2, I, pt
            LineTo .Hdc, L + 2, I + 1
            MoveToEx .Hdc, R - 1, I, pt
            LineTo .Hdc, R - 1, I + 1
            SelectObject .Hdc, Pen
            DeleteObject hPen
            If ColorB >= 228 Then
                ColorR = ColorR - 4
                ColorG = ColorG - 3
                ColorB = ColorB - 1
            End If
        Next I
        hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 1, B - 3, pt
        LineTo .Hdc, R - 1, B - 3
        SelectObject .Hdc, Pen
        DeleteObject hPen
        SetPixel .Hdc, L + 2, B - 2, RGB(77, 125, 193)
        hPen = CreatePen(PS_SOLID, 1, RGB(97, 125, 229))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 3, B - 2, pt
        LineTo .Hdc, R - 2, B - 2
        SetPixel .Hdc, R - 2, B - 2, RGB(77, 125, 193)
        SelectObject .Hdc, Pen
        DeleteObject hPen
    End With 'USERCONTROL

End Sub

Private Sub DrawHighlight()

'<:-) :WARNING: Large Code procedure (71 lines of code)
'<:-) It is recommended that you try to break it into smaller procedures

Dim pt     As POINTAPI
Dim Pen    As Long
Dim hPen   As Long
Dim I      As Long
Dim ColorR As Long
Dim ColorG As Long
Dim ColorB As Long

    With UserControl
        'top line
        hPen = CreatePen(PS_SOLID, 1, RGB(255, 240, 207))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 2, t + 1, pt
        LineTo .Hdc, R - 1, t + 1
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(253, 216, 137))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 1, t + 2, pt
        LineTo .Hdc, R, t + 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
        'draw gradient
        ColorR = 254
        ColorG = 223
        ColorB = 154
        For I = t + 2 To B - 3 Step 1
            hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
            Pen = SelectObject(.Hdc, hPen)
            MoveToEx .Hdc, L + 1, I, pt
            LineTo .Hdc, L + 1, I + 1
            MoveToEx .Hdc, R - 1, I, pt
            LineTo .Hdc, R - 1, I + 1
            SelectObject .Hdc, Pen
            DeleteObject hPen
            If ColorB >= 49 Then
                ColorR = ColorR - 1
                ColorG = ColorG - 3
                ColorB = ColorB - 7
            End If
        Next I
        ColorR = 252
        ColorG = 210
        ColorB = 121
        For I = t + 3 To B - 3 Step 1
            hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
            Pen = SelectObject(.Hdc, hPen)
            MoveToEx .Hdc, L + 2, I, pt
            LineTo .Hdc, L + 2, I + 1
            MoveToEx .Hdc, R - 2, I, pt
            LineTo .Hdc, R - 2, I + 1
            SelectObject .Hdc, Pen
            DeleteObject hPen
            If ColorB >= 57 Then
                ColorR = ColorR - 1
                ColorG = ColorG - 4
                ColorB = ColorB - 8
            End If
        Next I
        hPen = CreatePen(PS_SOLID, 1, RGB(ColorR, ColorG, ColorB))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 3, B - 3, pt
        LineTo .Hdc, R, B - 3
        SelectObject .Hdc, Pen
        DeleteObject hPen
        hPen = CreatePen(PS_SOLID, 1, RGB(229, 151, 0))
        Pen = SelectObject(.Hdc, hPen)
        MoveToEx .Hdc, L + 2, B - 2, pt
        LineTo .Hdc, R - 1, B - 2
        SelectObject .Hdc, Pen
        DeleteObject hPen
    End With 'USERCONTROL

End Sub

Public Property Get Enabled() As Boolean

    Enabled = mEnabled

End Property

Public Property Let Enabled(ByVal NewValue As Boolean)

    mEnabled = NewValue
    PropertyChanged "Enabled"
    UserControl.Enabled = NewValue