sijobutton.ctl

漂亮的vb 程序

End Property

Public Property Let SpecialEffect(ByVal newValue As fx)
    SFX = newValue
    Call Redraw(lastStat, True)
    PropertyChanged "FX"
End Property

Public Property Get CheckBoxBehaviour() As Boolean
    CheckBoxBehaviour = isCheckbox
End Property

Public Property Let CheckBoxBehaviour(ByVal newValue As Boolean)
    isCheckbox = newValue
    Call Redraw(lastStat, True)
    PropertyChanged "CHECK"
End Property

Public Property Get Value() As Boolean
    Value = cValue
End Property

Public Property Let Value(ByVal newValue As Boolean)
    cValue = newValue
    If isCheckbox Then Call Redraw(0, True)
    PropertyChanged "VALUE"
End Property

Public Property Get Version() As String
    Version = cbVersion
End Property

'########## END OF PROPERTIES ##########

Private Sub UserControl_Resize()
If inLoop Then Exit Sub
    'get button size
    GetClientRect UserControl.hWnd, rc3
    'assign these values to He and Wi
    He = rc3.Bottom: Wi = rc3.Right
    'build the FocusRect size and position depending on the button type
    If MyButtonType >= [Simple Flat] And MyButtonType <= [Oval Flat] Then
        InflateRect rc3, -3, -3
    ElseIf MyButtonType = [KDE 2] Then
        InflateRect rc3, -5, -5
        OffsetRect rc3, 1, 1
    Else
        InflateRect rc3, -4, -4
    End If
    Call CalcTextRects
    
    If rgnNorm Then DeleteObject rgnNorm
    Call MakeRegion
    SetWindowRgn UserControl.hWnd, rgnNorm, True
    
    If He Then Call Redraw(0, True)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
    MyButtonType = .ReadProperty("BTYPE", 2)
    elTex = .ReadProperty("TX", "")
    isEnabled = .ReadProperty("ENAB", True)
    Set UserControl.Font = .ReadProperty("FONT", UserControl.Font)
    MyColorType = .ReadProperty("COLTYPE", 1)
    showFocusR = .ReadProperty("FOCUSR", True)
    BackC = .ReadProperty("BCOL", GetSysColor(COLOR_BTNFACE))
    BackO = .ReadProperty("BCOLO", BackC)
    ForeC = .ReadProperty("FCOL", GetSysColor(COLOR_BTNTEXT))
    ForeO = .ReadProperty("FCOLO", ForeC)
    MaskC = .ReadProperty("MCOL", &HC0C0C0)
    UserControl.MousePointer = .ReadProperty("MPTR", 0)
    Set UserControl.MouseIcon = .ReadProperty("MICON", Nothing)
    Set picNormal = .ReadProperty("PICN", Nothing)
    Set picHover = .ReadProperty("PICH", Nothing)
    useMask = .ReadProperty("UMCOL", True)
    isSoft = .ReadProperty("SOFT", False)
    PicPosition = .ReadProperty("PICPOS", 0)
    useGrey = .ReadProperty("NGREY", False)
    SFX = .ReadProperty("FX", 0)
    Me.HandPointer = .ReadProperty("HAND", False)
    isCheckbox = .ReadProperty("CHECK", False)
    cValue = .ReadProperty("VALUE", False)
End With

    UserControl.Enabled = isEnabled
    Call CalcPicSize
    Call CalcTextRects
    Call SetAccessKeys
End Sub

Private Sub UserControl_Show()

If MyButtonType = 11 Then
    If pDC = 0 Then
        pDC = CreateCompatibleDC(UserControl.hdc): pBM = CreateBitmap(Wi, He, 1, GetDeviceCaps(hdc, 12), ByVal 0&)
        oBM = SelectObject(pDC, pBM)
    End If
    
    Call GetParentPic
End If

isShown = True
Call SetColors
Call Redraw(0, True)
End Sub

Private Sub UserControl_Terminate()
    isShown = False
    DeleteObject rgnNorm
    If pDC Then
        DeleteObject SelectObject(pDC, oBM)
        DeleteDC pDC
    End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
    Call .WriteProperty("BTYPE", MyButtonType)
    Call .WriteProperty("TX", elTex)
    Call .WriteProperty("ENAB", isEnabled)
    Call .WriteProperty("FONT", UserControl.Font)
    Call .WriteProperty("COLTYPE", MyColorType)
    Call .WriteProperty("FOCUSR", showFocusR)
    Call .WriteProperty("BCOL", BackC)
    Call .WriteProperty("BCOLO", BackO)
    Call .WriteProperty("FCOL", ForeC)
    Call .WriteProperty("FCOLO", ForeO)
    Call .WriteProperty("MCOL", MaskC)
    Call .WriteProperty("MPTR", UserControl.MousePointer)
    Call .WriteProperty("MICON", UserControl.MouseIcon)
    Call .WriteProperty("PICN", picNormal)
    Call .WriteProperty("PICH", picHover)
    Call .WriteProperty("UMCOL", useMask)
    Call .WriteProperty("SOFT", isSoft)
    Call .WriteProperty("PICPOS", PicPosition)
    Call .WriteProperty("NGREY", useGrey)
    Call .WriteProperty("FX", SFX)
    Call .WriteProperty("HAND", useHand)
    Call .WriteProperty("CHECK", isCheckbox)
    Call .WriteProperty("VALUE", cValue)
End With
End Sub

Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)
'here is the CORE of the button, everything is drawn here
'it's not well commented but i think that everything is
'pretty self explanatory...
    
If isCheckbox And cValue Then curStat = 2

If Not Force Then  'check drawing redundancy
    If (curStat = lastStat) And (TE = elTex) Then Exit Sub
End If

If He = 0 Or Not isShown Then Exit Sub   'we don't want errors

lastStat = curStat
TE = elTex

Dim i As Long, stepXP1 As Single, XPFace2 As Long, tempCol As Long

With UserControl
.Cls
If isOver And MyColorType = Custom Then tempCol = BackC: BackC = BackO: SetColors

DrawRectangle 0, 0, Wi, He, cFace

If isEnabled Then
    If curStat = 0 Then
'#@#@#@#@#@# BUTTON NORMAL STATE #@#@#@#@#@#
        Select Case MyButtonType
            Case 1 'Windows 16-bit
                Call DrawCaption(Abs(isOver))
                DrawFrame cHighLight, cShadow, cHighLight, cShadow, True
                DrawRectangle 0, 0, Wi, He, cDarkShadow, True
                Call DrawFocusR
            Case 2 'Windows 32-bit
                Call DrawCaption(Abs(isOver))
                If Ambient.DisplayAsDefault And showFocusR Then
                    DrawFrame cHighLight, cDarkShadow, cLight, cShadow, True
                    Call DrawFocusR
                    DrawRectangle 0, 0, Wi, He, cDarkShadow, True
                Else
                    DrawFrame cHighLight, cDarkShadow, cLight, cShadow, False
                End If
            Case 3 'Windows XP
                stepXP1 = 25 / He
                For i = 1 To He
                    DrawLine 0, i, Wi, i, ShiftColor(XPFace, -stepXP1 * i, True)
                Next
                Call DrawCaption(Abs(isOver))
                DrawRectangle 0, 0, Wi, He, &H733C00, True
                mSetPixel 1, 1, &H7B4D10
                mSetPixel 1, He - 2, &H7B4D10
                mSetPixel Wi - 2, 1, &H7B4D10
                mSetPixel Wi - 2, He - 2, &H7B4D10
                
                If isOver Then
                    DrawRectangle 1, 2, Wi - 2, He - 4, &H31B2FF, True
                    DrawLine 2, He - 2, Wi - 2, He - 2, &H96E7&
                    DrawLine 2, 1, Wi - 2, 1, &HCEF3FF
                    DrawLine 1, 2, Wi - 1, 2, &H8CDBFF
                    DrawLine 2, 3, 2, He - 3, &H6BCBFF
                    DrawLine Wi - 3, 3, Wi - 3, He - 3, &H6BCBFF
                ElseIf ((HasFocus Or Ambient.DisplayAsDefault) And showFocusR) Then
                    DrawRectangle 1, 2, Wi - 2, He - 4, &HE7AE8C, True
                    DrawLine 2, He - 2, Wi - 2, He - 2, &HEF826B
                    DrawLine 2, 1, Wi - 2, 1, &HFFE7CE
                    DrawLine 1, 2, Wi - 1, 2, &HF7D7BD
                    DrawLine 2, 3, 2, He - 3, &HF0D1B5
                    DrawLine Wi - 3, 3, Wi - 3, He - 3, &HF0D1B5
                Else 'we do not draw the bevel always because the above code would repaint over it
                    DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPFace, -&H30, True)
                    DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPFace, -&H20, True)
                    DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPFace, -&H24, True)
                    DrawLine Wi - 3, 3, Wi - 3, He - 3, ShiftColor(XPFace, -&H18, True)
                    DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPFace, &H10, True)
                    DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPFace, &HA, True)
                    DrawLine 1, 2, 1, He - 2, ShiftColor(XPFace, -&H5, True)
                    DrawLine 2, 3, 2, He - 3, ShiftColor(XPFace, -&HA, True)
                End If
            Case 4 'Mac
                DrawRectangle 1, 1, Wi - 2, He - 2, cLight
                Call DrawCaption(Abs(isOver))
                DrawRectangle 0, 0, Wi, He, cDarkShadow, True
                mSetPixel 1, 1, cDarkShadow
                mSetPixel 1, He - 2, cDarkShadow
                mSetPixel Wi - 2, 1, cDarkShadow
                mSetPixel Wi - 2, He - 2, cDarkShadow
                DrawLine 1, 2, 2, 0, cFace
                DrawLine 3, 2, Wi - 3, 2, cHighLight
                DrawLine 2, 2, 2, He - 3, cHighLight
                mSetPixel 3, 3, cHighLight
                DrawLine Wi - 3, 1, Wi - 3, He - 3, cFace
                DrawLine 1, He - 3, Wi - 3, He - 3, cFace
                mSetPixel Wi - 4, He - 4, cFace
                DrawLine Wi - 2, 2, Wi - 2, He - 2, cShadow
                DrawLine 2, He - 2, Wi - 2, He - 2, cShadow
                mSetPixel Wi - 3, He - 3, cShadow
            Case 5 'Java
                DrawRectangle 1, 1, Wi - 1, He - 1, ShiftColor(cFace, &HC)
                Call DrawCaption(Abs(isOver))
                DrawRectangle 1, 1, Wi - 1, He - 1, cHighLight, True
                DrawRectangle 0, 0, Wi - 1, He - 1, ShiftColor(cShadow, -&H1A), True
                mSetPixel 1, He - 2, ShiftColor(cShadow, &H1A)
                mSetPixel Wi - 2, 1, ShiftColor(cShadow, &H1A)
                If HasFocus And showFocusR Then DrawRectangle rc.Left - 2, rc.Top - 1, fc.X + 4, fc.Y + 2, &HCC9999, True
            Case 6 'Netscape
                Call DrawCaption(Abs(isOver))
                DrawFrame ShiftColor(cLight, &H8), cShadow, ShiftColor(cLight, &H8), cShadow, False
                Call DrawFocusR
            Case 7, 8, 12 'Flat buttons
                Call DrawCaption(Abs(isOver))
                If (MyButtonType = [Simple Flat]) Then
                    DrawFrame cHighLight, cShadow, 0, 0, False, True
                ElseIf isOver Then
                    If MyButtonType = [Flat Highlight] Then
                        DrawFrame cHighLight, cShadow, 0, 0, False, True
                    Else
                        DrawFrame cHighLight, cDarkShadow, cLight, cShadow, False, False
                    End If
                End If
                Call DrawFocusR
            Case 9 'Office XP
                If isOver Then DrawRectangle 1, 1, Wi, He, OXPf
                Call DrawCaption(Abs(isOver))
                If isOver Then DrawRectangle 0, 0, Wi, He, OXPb, True
                Call DrawFocusR
            Case 11 'transparent
                BitBlt hdc, 0, 0, Wi, He, pDC, 0, 0, vbSrcCopy
                Call DrawCaption(Abs(isOver))
                Call DrawFocusR
            Case 13 'Oval
                DrawEllipse 0, 0, Wi, He, Abs(isOver) * cShadow + Abs(Not isOver) * cFace, cFace
                Call DrawCaption(Abs(isOver))
            Case 14 'KDE 2
                Dim prevBold As Boolean
                If Not isOver Then
                    stepXP1 = 58 / He
                    For i = 1 To He
                        DrawLine 0, i, Wi, i, ShiftColor(cHighLight, -stepXP1 * i)
                    Next
                Else
                    DrawRectangle 0, 0, Wi, He, cLight
                End If
                If Ambient.DisplayAsDefault Then isShown = False: prevBold = Me.FontBold: Me.FontBold = True
                Call DrawCaption(Abs(isOver))
                If Ambient.DisplayAsDefault Then Me.FontBold = prevBold: isShown = True
                DrawRectangle 0, 0, Wi, He, ShiftColor(cShadow, -&H32), True
                DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cFace, -&H9), True
                DrawRectangle 2, 2, Wi - 4, 2, cHighLight
                DrawRectangle 2, 4, 2, He - 6, cHighLight
                Call DrawFocusR
        End Select
        Call DrawPictures(0)
    ElseIf curStat = 2 Then
'#@#@#@#@#@# BUTTON IS DOWN #@#@#@#@#@#
        Select Case MyButtonType
            Case 1 'Windows 16-bit
                Call DrawCaption(2)
                DrawFrame cShadow, cHighLight, cShadow, cHighLight, True
                DrawRectangle 0, 0, Wi, He, cDarkShadow, True
                Call DrawFocusR
            Case 2 'Windows 32-bit
                Call DrawCaption(2)
                If showFocusR And Ambient.DisplayAsDefault Then
                    DrawRectangle 0, 0, Wi, He, cDarkShadow, True
                    DrawRectangle 1, 1, Wi - 2, He - 2, cShadow, True
                    Call DrawFocusR
                Else
                    DrawFrame cDarkShadow, cHighLight, cShadow, cLight, False
                End If
            Case 3 'Windows XP
                stepXP1 = 25 / He
                XPFace2 = ShiftColor(XPFace, -32, True)
                For i = 1 To He
                    DrawLine 0, He - i, Wi, He - i, ShiftColor(XPFace2, -stepXP1 * i, True)
                Next
                Call DrawCaption(2)
                DrawRectangle 0, 0, Wi, He, &H733C00, True
                mSetPixel 1, 1, &H7B4D10
                mSetPixel 1, He - 2, &H7B4D10
                mSetPixel Wi - 2, 1, &H7B4D10
                mSetPixel Wi - 2, He - 2, &H7B4D10
                
                DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPFace2, &H10, True)
                DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPFace2, &HA, True)
                DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPFace2, &H5, True)
                DrawLine Wi - 3, 3, Wi - 3, He - 3, XPFace
                DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPFace2, -&H20, True)
                DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPFace2, -&H18, True)
                DrawLine 1, 2, 1, He - 2, ShiftColor(XPFace2, -&H20, True)
                DrawLine 2, 2, 2, He - 2, ShiftColor(XPFace2, -&H16, True)
            Case 4 'Mac
                DrawRectangle 1, 1, Wi - 2, He - 2, ShiftColor(cShadow, -&H10)
                XPFace = ShiftColor(cShadow, -&H10)
                Call DrawCaption(2)