command.ctl

高级卸载工具

VERSION 5.00
Begin VB.UserControl CommandButton 
   AutoRedraw      =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
End
Attribute VB_Name = "CommandButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'★★★★★****************************★★★★★**********************★★★★★
'金诺VB园-收藏整理
'本站是专注于VB和VBNET编程的源码下载站
'发布日期：2008-3-14 22:00:47
'网    站：http://www.vbget.com/          (金诺VB园)
'网    站：http://www.vbget.com/daohan/   (VB编程网址导航)
'E-Mail  ：[e-mail]
'QQ      ：158676144
'源码作者：如果您有VB商业源码需要获得收益，本站将有VIP收费下载频道可供你发布!
'         您有权定价;改价;删除;及即时查看下载量(即收益)，所有收益全部归您！
'         本站将在双方协商的一个金额周期内打款到作者帐户中，您只需负责打款费用！
'         本站只作为一个平台提供最新VB源码咨讯和源码下载！
'本注释由<站长工具之智能注释>软件自动添加！金诺VB园有此软件下载！
'★★★★★****************************★★★★★**********************★★★★★


Option Explicit

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Type SepRGB
    Red As Single
    Green As Single
    Blue As Single
End Type

Private Const DisabledForeColor As Long = 9740965

Private Const BorderColorLines As Long = 7549440
Private Const FirstBottomLine As Long = 15199215
Private Const SecondBottomLine As Long = 14082023
Private Const ThirdBottomLine As Long = 13030358

Private Const FirstCornerPixel As Long = 8672545
Private Const SecondCornerPixel As Long = 11376251
Private Const ThirdCornerPixel As Long = 10845522
Private Const FourthCornerPixel As Long = 14602182
    
Private Const FromColorFade As Long = 16250871
Private Const ToColorFade As Long = 15199215

' Disabled Colors
Private Const BorderColorLinesX As Long = 12437454
Private Const FirstBottomLineX As Long = 15726583
Private Const SecondBottomLineX As Long = 15726583
Private Const ThirdBottomLineX As Long = 15726583
    
Private Const FirstCornerPixelX As Long = 12437454
Private Const SecondCornerPixelX As Long = 12437454
Private Const ThirdCornerPixelX As Long = 12437454
Private Const FourthCornerPixelX As Long = 12437454
    
Private Const FromColorFadeX As Long = 15726583
Private Const ToColorFadeX As Long = 15726583
    
' Down colors
Private Const BorderColorLinesD As Long = 7549440
Private Const FirstBottomLineD As Long = 15199215
Private Const SecondBottomLineD As Long = 14082023
Private Const ThirdBottomLineD As Long = 15725559
    
Private Const FirstCornerPixelD As Long = 8672545
Private Const SecondCornerPixelD As Long = 11376251
Private Const ThirdCornerPixelD As Long = 10845522
Private Const FourthCornerPixelD As Long = 14602182
    
Private Const FromColorFadeD As Long = 14607335
Private Const ToColorFadeD As Long = 14607335
    
' Has focus colors
Private Const BorderColorLinesF As Long = 7549440
Private Const FirstTopLineF As Long = 16771022
Private Const SecondTopLineF As Long = 16242621
Private Const FirstBottomLineF As Long = 15199215
    
Private Const SecondBottomLineF As Long = 15183500
Private Const ThirdBottomLineF As Long = 15696491
Private Const FirstCornerPixelF As Long = 8672545
Private Const SecondCornerPixelF As Long = 11376251
    
Private Const ThirdCornerPixelF As Long = 10845522
Private Const FourthCornerPixelF As Long = 14602182
Private Const FromColorFadeF As Long = 16250871
Private Const ToColorFadeF As Long = 15199215
    
Private Const SideFromColorFadeF As Long = 16241597
Private Const SideToColorFadeF As Long = 15183500

' HOT Colors
Private Const BorderColorLinesH As Long = 7549440
Private Const FirstTopLineH As Long = 13562879
Private Const SecondTopLineH As Long = 9231359
Private Const FirstBottomLineH As Long = 15199215
    
Private Const SecondBottomLineH As Long = 3257087
Private Const ThirdBottomLineH As Long = 38630
Private Const FirstCornerPixelH As Long = 8672545
Private Const SecondCornerPixelH As Long = 11376251
    
Private Const ThirdCornerPixelH As Long = 10845522
Private Const FourthCornerPixelH As Long = 14602182
Private Const FromColorFadeH As Long = 16250871
Private Const ToColorFadeH As Long = 15199215
    
Private Const SideFromColorFadeH As Long = 10280929
Private Const SideToColorFadeH As Long = 3192575
    
Private PropCaption As String
Private HasFocus As Boolean
Private MouseOver As Boolean
Private MouseDown As Boolean
Private PropEnabled As Boolean
Private PropForeColor As Long

Event Click()
Event DblClick()
Event MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Event MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)

Public Property Let ForeColor(NewValue As OLE_COLOR)
    PropForeColor = NewValue
    Redraw
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = PropForeColor
End Property

Public Property Let Caption(NewValue As String)
    PropCaption = NewValue
    Redraw
End Property

Public Property Get Caption() As String
    Caption = PropCaption
End Property

Public Property Set Font(NewValue As StdFont)
    Set UserControl.Font = NewValue
    Redraw
End Property

Public Property Get Font() As StdFont
    Set Font = UserControl.Font
End Property

Public Property Let Enabled(NewValue As Boolean)
    PropEnabled = NewValue
    Redraw
End Property

Public Property Get Enabled() As Boolean
    Enabled = PropEnabled
End Property

Private Function CreateFade(FromColor As Long, ToColor As Long, FadeLength As Long) As Collection
    Dim Increment As SepRGB, ToColorRGB As SepRGB, FromColorRGB As SepRGB, SubRGB As SepRGB
    Dim Final As SepRGB, Results As New Collection, x As Long

    If FromColor = ToColor Then
        For x = 1 To FadeLength
            Results.Add FromColor
        Next
        GoTo ThatsIt
    End If

    ToColorRGB = GetRGB(ToColor)
    FromColorRGB = GetRGB(FromColor)

    With SubRGB
        .Red = Abs(ToColorRGB.Red - FromColorRGB.Red)
        .Green = Abs(ToColorRGB.Green - FromColorRGB.Green)
        .Blue = Abs(ToColorRGB.Blue - FromColorRGB.Blue)
    End With

    With Increment
        .Red = SubRGB.Red / FadeLength
        .Green = SubRGB.Green / FadeLength
        .Blue = SubRGB.Blue / FadeLength
    End With

    With Final
        .Red = FromColorRGB.Red
        .Green = FromColorRGB.Green
        .Blue = FromColorRGB.Blue

        For x = 1 To FadeLength
            Results.Add RGB(.Red, .Green, .Blue)
        
            If .Red <> ToColorRGB.Red Then If .Red > ToColorRGB.Red Then .Red = .Red - Increment.Red Else .Red = .Red + Increment.Red
            If .Green <> ToColorRGB.Green Then If .Green > ToColorRGB.Green Then .Green = .Green - Increment.Green Else .Green = .Green + Increment.Green
            If .Blue <> ToColorRGB.Blue Then If .Blue > ToColorRGB.Blue Then .Blue = .Blue - Increment.Blue Else .Blue = .Blue + Increment.Blue
        Next
    End With

ThatsIt:
    Set CreateFade = Results
End Function

Private Function GetRGB(ByVal LongValue As Long) As SepRGB
    LongValue = Abs(LongValue)
    GetRGB.Red = LongValue And 255
    GetRGB.Green = (LongValue \ 256) And 255
    GetRGB.Blue = (LongValue \ 65536) And 255
End Function

Private Sub Redraw()
    Dim sCaption() As String, endCaption As String, x As Long
    Cls

    If PropEnabled = False Then
        DrawDisabled
        GoTo DrawCaption
    End If

    If MouseDown = True Then
        If MouseOver = True Then
            DrawDown
        Else
            GoTo DoOthers
        End If
    Else
DoOthers:
        If MouseOver = True Then
            DrawHot
        Else
            If HasFocus = False Then
                DrawIdle
            Else
                DrawFocus
            End If
        End If
    End If

DrawCaption:
    If LenB(PropCaption) = 0 Then Exit Sub

    With UserControl
        If PropEnabled = True Then
            UserControl.ForeColor = PropForeColor
        Else
            UserControl.ForeColor = DisabledForeColor
        End If
    
        ' Draws the caption.
        sCaption = Split(PropCaption, " ")
        
        For x = 0 To UBound(sCaption)
            ' See how much text can fit on one line before I add a line break.
            
            If TextWidth(endCaption & sCaption(x)) > .ScaleWidth - 3 Then
                If LenB(endCaption) <> 0 Then endCaption = Left$(endCaption, Len(endCaption) - 1)
                endCaption = endCaption & vbCrLf
            End If
            
            endCaption = endCaption & sCaption(x) & " "
        Next
        
        endCaption = Left$(endCaption, Len(endCaption) - 1)
        sCaption = Split(endCaption, vbCrLf)
        
        .CurrentY = (.ScaleHeight / 2) - (TextHeight(endCaption) / 2)

        For x = 0 To UBound(sCaption)
            ' Now draw each new line in the middle of the control.
            
            .CurrentX = (.ScaleWidth / 2) - (TextWidth(sCaption(x)) / 2)
            Print sCaption(x)
        Next
    End With
End Sub

Private Sub DrawFocus()
    Dim Gradient As New Collection, x As Long

    With UserControl
    ' Draws border lines (not corners)
        Line (3, 0)-(.ScaleWidth - 3, 0), BorderColorLinesF
        Line (0, 3)-(0, .ScaleHeight - 3), BorderColorLinesF
        Line (3, .ScaleHeight - 1)-(.ScaleWidth - 3, .ScaleHeight - 1), BorderColorLinesF
        Line (.ScaleWidth - 1, 3)-(.ScaleWidth - 1, .ScaleHeight - 3), BorderColorLinesF
    
    ' Draws the fade at the bottom.
        Line (1, .ScaleHeight - 4)-(.ScaleWidth - 1, .ScaleHeight - 4), FirstBottomLineF
        Line (2, .ScaleHeight - 3)-(.ScaleWidth - 2, .ScaleHeight - 3), SecondBottomLineF
        Line (3, ScaleHeight - 2)-(.ScaleWidth - 3, .ScaleHeight - 2), ThirdBottomLineF
        
    ' Draws the background gradient.
        Set Gradient = CreateFade(FromColorFadeF, ToColorFadeF, .ScaleHeight - 5)
        
        For x = 1 To Gradient.Count
            Select Case x
                Case 1
                    Line (3, x + 1)-(.ScaleWidth - 4, x + 1), FirstTopLineF
                Case 2
                    Line (2, x + 1)-(.ScaleWidth - 3, x + 1), SecondTopLineF
                Case Else
                    Line (1, x + 1)-(.ScaleWidth - 2, x + 1), Gradient(x)
            End Select
        Next
    
    ' Draws side gradients
        Set Gradient = CreateFade(SideFromColorFadeF, SideToColorFadeF, .ScaleHeight - 7)
        
        For x = 1 To Gradient.Count
            PSet (1, x + 3), Gradient(x)
            PSet (2, x + 3), Gradient(x)
            
            PSet (.ScaleWidth - 2, x + 3), Gradient(x)
            PSet (.ScaleWidth - 3, x + 3), Gradient(x)
        Next
        
    ' Draws corners
    ' First set of pixels
        
        ' Upper Left Corner
        PSet (2, 0), FirstCornerPixelF
        PSet (0, 2), FirstCornerPixelF
        
        ' Bottom left corner
        PSet (0, .ScaleHeight - 3), FirstCornerPixelF
        PSet (2, .ScaleHeight - 1), FirstCornerPixelF
        
        ' Top right corner
        PSet (.ScaleWidth - 1, 2), FirstCornerPixelF
        PSet (.ScaleWidth - 3, 0), FirstCornerPixelF
        
        ' Bottom right corner
        PSet (.ScaleWidth - 3, .ScaleHeight - 1), FirstCornerPixelF
        PSet (.ScaleWidth - 1, .ScaleHeight - 3), FirstCornerPixelF
        
    ' Second set of pixels
        ' Upper Left Corner
        PSet (1, 0), SecondCornerPixelF
        PSet (0, 1), SecondCornerPixelF
        
        ' Bottom left corner
        PSet (0, .ScaleHeight - 2), SecondCornerPixelF
        PSet (1, .ScaleHeight - 1), SecondCornerPixelF
        
        ' Top right corner
        PSet (.ScaleWidth - 1, 1), SecondCornerPixelF
        PSet (.ScaleWidth - 2, 0), SecondCornerPixelF
        
        ' Bottom right corner
        PSet (.ScaleWidth - 2, .ScaleHeight - 1), SecondCornerPixelF
        PSet (.ScaleWidth - 1, .ScaleHeight - 2), SecondCornerPixelF
    
    ' Third set of pixels
        PSet (1, 1), ThirdCornerPixelF
        PSet (1, .ScaleHeight - 2), ThirdCornerPixelF
        PSet (.ScaleWidth - 2, 1), ThirdCornerPixelF
        PSet (.ScaleWidth - 2, .ScaleHeight - 2), ThirdCornerPixelF
    
    'Fourth set of pixels
        ' Upper left corner
        PSet (2, 1), FourthCornerPixelF
        PSet (1, 2), FourthCornerPixelF
        
        ' Bottom left corner
        PSet (1, .ScaleHeight - 3), FourthCornerPixelF
        PSet (2, .ScaleHeight - 2), FourthCornerPixelF
        
        ' Bottom right corner
        PSet (.ScaleWidth - 3, .ScaleHeight - 2), FourthCornerPixelF
        PSet (.ScaleWidth - 2, .ScaleHeight - 3), FourthCornerPixelF
        
        ' Top right corner.
        PSet (.ScaleWidth - 3, 1), FourthCornerPixelF
        PSet (.ScaleWidth - 2, 2), FourthCornerPixelF
    End With
End Sub

Private Sub DrawDown()
    Dim x As Long, Gradient As New Collection

    With UserControl
    ' Draws border lines (not corners)
        Line (3, 0)-(.ScaleWidth - 3, 0), BorderColorLinesD
        Line (0, 3)-(0, .ScaleHeight - 3), BorderColorLinesD
        Line (3, .ScaleHeight - 1)-(.ScaleWidth - 3, .ScaleHeight - 1), BorderColorLinesD
        Line (.ScaleWidth - 1, 3)-(.ScaleWidth - 1, .ScaleHeight - 3), BorderColorLinesD
    
    ' Draws the fade at the bottom
        Line (1, .ScaleHeight - 4)-(.ScaleWidth - 1, .ScaleHeight - 4), FirstBottomLineD
        Line (2, .ScaleHeight - 3)-(.ScaleWidth - 2, .ScaleHeight - 3), SecondBottomLineD
        Line (3, ScaleHeight - 2)-(.ScaleWidth - 3, .ScaleHeight - 2), ThirdBottomLineD
        
    ' Draws the background gradient
        Set Gradient = CreateFade(FromColorFadeD, ToColorFadeD, .ScaleHeight - 5)
        
        For x = 1 To Gradient.Count
            Select Case x
                Case 1
                    Line (3, x + 1)-(.ScaleWidth - 4, x + 1), Gradient(x)
                Case 2
                    Line (2, x + 1)-(.ScaleWidth - 3, x + 1), Gradient(x)
                Case Else
                    Line (1, x + 1)-(.ScaleWidth - 2, x + 1), Gradient(x)
            End Select