button.ctl

一个功能特别的WINXP的科学计算器

    
    'Set rect 3
    RC3.Left = 4
    RC3.Top = 4
    RC3.Right = Width - 4
    RC3.Bottom = Height - 4
    
    Redraw 0, True          'Redraw
    
End Sub


'Read Properties
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    cColor = PropBag.ReadProperty("ForeColor", &H80000012)
    CurrText = PropBag.ReadProperty("TX", "")                       'Caption
    isEnabled = PropBag.ReadProperty("ENAB", True)                  'Enabled
    Set CurrFont = PropBag.ReadProperty("FONT", UserControl.Font)   'Font
    
    UserControl.Enabled = isEnabled     'Set enabled state
    Set UserControl.Font = CurrFont     'Set font
    
    SetColors       'Set colours
    Redraw 0, True  'Redraw

End Sub


'Write properties
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ForeColor", cColor, &H80000012)
    PropBag.WriteProperty "TX", CurrText    'Caption
    PropBag.WriteProperty "ENAB", isEnabled 'Enabled state
    PropBag.WriteProperty "FONT", CurrFont  'Font

End Sub


'Redraw
Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)

  Dim i               As Long
  Dim stepXP1         As Single
  Dim XPface          As Long

    'No errors
    If Height = 0 Then Exit Sub
    
    lastStat = curStat  'Set property
    TE = CurrText       'Caption

    With UserControl
        .Cls                                        'Clear control
        DrawRectangle 0, 0, Width, Height, cFace    'Draw button face
        
        If isEnabled = True Then            'If enabled
            SetTextColor .hDC, cText        'Set text colour
            
            If curStat = 0 Then             'If button is up
                
                 'Gradient step
                stepXP1 = 25 / Height
                'Shift color
                XPface = ShiftColor(cFace, &H30)
                'Draw gradient background
                For i = 1 To Height
                    DrawLine 0, i, Width, i, ShiftColor(XPface, -stepXP1 * i)
                Next
                'Set caption
                SetTextColor UserControl.hDC, cColor
                DrawText .hDC, CurrText, Len(CurrText), RC, DT_CENTERABS
                'Draw outline
                DrawLine 2, 0, Width - 2, 0, &H733C00
                DrawLine 2, Height - 1, Width - 2, Height - 1, &H733C00
                DrawLine 0, 2, 0, Height - 2, &H733C00
                DrawLine Width - 1, 2, Width - 1, Height - 2, &H733C00
                'Draw corners
                SetPixel UserControl.hDC, 1, 1, &H7B4D10
                SetPixel UserControl.hDC, 1, Height - 2, &H7B4D10
                SetPixel UserControl.hDC, Width - 2, 1, &H7B4D10
                SetPixel UserControl.hDC, Width - 2, Height - 2, &H7B4D10
                'Draw shadows
                DrawLine 2, Height - 2, Width - 2, Height - 2, ShiftColor(XPface, -&H30)
                DrawLine 1, Height - 3, Width - 2, Height - 3, ShiftColor(XPface, -&H20)
                DrawLine Width - 2, 2, Width - 2, Height - 2, ShiftColor(XPface, -&H24)
                DrawLine Width - 3, 3, Width - 3, Height - 3, ShiftColor(XPface, -&H18)
                'Draw highlights
                DrawLine 2, 1, Width - 2, 1, ShiftColor(XPface, &H10)
                DrawLine 1, 2, Width - 2, 2, ShiftColor(XPface, &HA)
                DrawLine 1, 2, 1, Height - 2, ShiftColor(XPface, -&H5)
                DrawLine 2, 3, 2, Height - 3, ShiftColor(XPface, -&HA)
            ElseIf curStat = 2 Then     'Button is down
                
                'Set gradient step
                stepXP1 = 15 / Height
                'Shift color
                XPface = ShiftColor(cFace, &H30)
                XPface = ShiftColor(XPface, -32)
                'Draw gradient background
                For i = 1 To Height
                    DrawLine 0, Height - i, Width, Height - i, ShiftColor(XPface, -stepXP1 * i)
                Next i
                'Draw caption
                SetTextColor .hDC, cColor
                DrawText .hDC, CurrText, Len(CurrText), RC2, DT_CENTERABS
                'Draw outline
                DrawLine 2, 0, Width - 2, 0, &H733C00
                DrawLine 2, Height - 1, Width - 2, Height - 1, &H733C00
                DrawLine 0, 2, 0, Height - 2, &H733C00
                DrawLine Width - 1, 2, Width - 1, Height - 2, &H733C00
                'Draw corners
                SetPixel UserControl.hDC, 1, 1, &H7B4D10
                SetPixel UserControl.hDC, 1, Height - 2, &H7B4D10
                SetPixel UserControl.hDC, Width - 2, 1, &H7B4D10
                SetPixel UserControl.hDC, Width - 2, Height - 2, &H7B4D10
                'Draw shadows
                DrawLine 2, Height - 2, Width - 2, Height - 2, ShiftColor(XPface, &H10)
                DrawLine 1, Height - 3, Width - 2, Height - 3, ShiftColor(XPface, &HA)
                DrawLine Width - 2, 2, Width - 2, Height - 2, ShiftColor(XPface, &H5)
                DrawLine Width - 3, 3, Width - 3, Height - 3, XPface
                'Draw highlights
                DrawLine 2, 1, Width - 2, 1, ShiftColor(XPface, -&H20)
                DrawLine 1, 2, Width - 2, 2, ShiftColor(XPface, -&H18)
                DrawLine 1, 2, 1, Height - 2, ShiftColor(XPface, -&H20)
                DrawLine 2, 2, 2, Height - 2, ShiftColor(XPface, -&H16)
            End If
        Else    'Disabled state
            
            'Shift color
            XPface = ShiftColor(cFace, &H30)
            'Draw button face
            DrawRectangle 0, 0, Width, Height, ShiftColor(XPface, -&H18)
            'Caption
            SetTextColor .hDC, ShiftColor(XPface, -&H68)
            DrawText .hDC, CurrText, Len(CurrText), RC, DT_CENTERABS
            'Draw outline
            DrawLine 2, 0, Width - 2, 0, ShiftColor(XPface, -&H54)
            DrawLine 2, Height - 1, Width - 2, Height - 1, ShiftColor(XPface, -&H54)
            DrawLine 0, 2, 0, Height - 2, ShiftColor(XPface, -&H54)
            DrawLine Width - 1, 2, Width - 1, Height - 2, ShiftColor(XPface, -&H54)
            'Draw corners
            SetPixel UserControl.hDC, 1, 1, ShiftColor(XPface, -&H48)
            SetPixel UserControl.hDC, 1, Height - 2, ShiftColor(XPface, -&H48)
            SetPixel UserControl.hDC, Width - 2, 1, ShiftColor(XPface, -&H48)
            SetPixel UserControl.hDC, Width - 2, Height - 2, ShiftColor(XPface, -&H48)
        End If
    End With
    
End Sub


'Draw rectangle
Private Sub DrawRectangle(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long, Optional OnlyBorder As Boolean = False)

  Dim bRect As RECT
  Dim hBrush As Long
  Dim Ret As Long
    
    'Fill out rect
    bRect.Left = X
    bRect.Top = Y
    bRect.Right = X + Width
    bRect.Bottom = Y + Height
    
    'Create brush
    hBrush = CreateSolidBrush(Color)
    
    If OnlyBorder = False Then  'Just border
        Ret = FillRect(UserControl.hDC, bRect, hBrush)
    Else    'Fill whole rect
        Ret = FrameRect(UserControl.hDC, bRect, hBrush)
    End If
    
    'Delete brush
    Ret = DeleteObject(hBrush)
    
End Sub


'Draw line
Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)

  Dim pt As POINTAPI

    UserControl.ForeColor = Color           'Set forecolor
    MoveToEx UserControl.hDC, X1, Y1, pt    'Move to X1/Y1
    LineTo UserControl.hDC, X2, Y2          'Draw line to X2/Y2
    
End Sub


'Set Colours
Private Sub SetColors()
    
    'Get system colours and save into variables
    cFace = RGB(200, 200, 255)
    
    '####################################
    '# cFace = GetSysColor(COLOR_BTNFACE)
    '####################################
    
    cShadow = GetSysColor(COLOR_BTNSHADOW)
    cLight = GetSysColor(COLOR_BTNLIGHT)
    cDarkShadow = GetSysColor(COLOR_BTNDKSHADOW)
    cHighLight = GetSysColor(COLOR_BTNHIGHLIGHT)
    cText = GetSysColor(COLOR_BTNTEXT)
    
End Sub


'Shift colors
Private Function ShiftColor(ByVal Color As Long, ByVal Value As Long) As Long

  Dim Red As Long, Blue As Long, Green As Long
    
    'Shift blue
    Blue = ((Color \ &H10000) Mod &H100)
    Blue = Blue + ((Blue * Value) \ &HC0)
    'Shift green
    Green = ((Color \ &H100) Mod &H100) + Value
    'Shift red
    Red = (Color And &HFF) + Value
    
    'Check red bounds
    If Red < 0 Then
        Red = 0
    ElseIf Red > 255 Then
        Red = 255
    End If
    'Check green bounds
    If Green < 0 Then
        Green = 0
    ElseIf Green > 255 Then
        Green = 255
    End If
    'Check blue bounds
    If Blue < 0 Then
        Blue = 0
    ElseIf Blue > 255 Then
        Blue = 255
    End If
    
    'Return color
    ShiftColor = RGB(Red, Green, Blue)
  
End Function