gurhanbutton.ctl

vb 24点计算.是一个智力小游戏

        .Strikethrough = New_Font.Strikethrough
    End With
    PropertyChanged "Font"
End Property

Private Sub g_Font_FontChanged(ByVal PropertyName As String)
    Set UserControl.Font = g_Font
    Refresh
End Sub

'?????????????????? LAZIM MI???????????
Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property

Public Property Get MousePointer() As MousePointerConstants
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get MouseIcon() As StdPicture
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As StdPicture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property
Public Property Get ShowBorderOnFocus() As Boolean
    ShowBorderOnFocus = m_ShowBorderOnFocus
End Property

Public Property Let ShowBorderOnFocus(ByVal New_ShowBorderOnFocus As Boolean)
    m_ShowBorderOnFocus = New_ShowBorderOnFocus
    PropertyChanged "ShowBorderOnFocus"
    Refresh
End Property

Public Property Get ShowFocusRect() As Boolean
    ShowFocusRect = m_ShowFocusRect
End Property

Public Property Let ShowFocusRect(ByVal New_ShowFocusRect As Boolean)
    m_ShowFocusRect = New_ShowFocusRect
    PropertyChanged "ShowFocusRect"
    Refresh
End Property
             
Private Sub RunXTRA3D(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
    Dim T As Integer
    Dim TEMPRENK As Long
                TEMPRENK = RENK
                BEVELDEPTHH = BEVELDEPTHH * (-1)
                
                For T = BEVELL To 0 Step -1
                    TEMPRENK = COLOR_DarkenLightenColor(TEMPRENK, BEVELDEPTHH)
                    Line (T, T)-(ScaleWidth - (T + 1), ScaleHeight - (T + 1)), TEMPRENK, B
                Next T
                
                BEVELDEPTHH = BEVELDEPTHH * (-1)
                For T = BEVELL To 0 Step -1
                    RENK = RGB(COLOR_LongToRGB(RENK).Red + BEVELDEPTHH, COLOR_LongToRGB(RENK).Green + BEVELDEPTHH, COLOR_LongToRGB(RENK).Blue + BEVELDEPTHH)
                    Line (T, T)-(ScaleWidth - (T + 1), T), RENK
                    Line (T, T)-(T, ScaleHeight - (T + 1)), RENK
                Next T
End Sub
Private Sub RunXTRA3D_PRESSED(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
    Dim Ret As Integer
    Dim GRIN As Integer
    Dim BLU As Integer
    Dim T As Integer
                Dim TEMPRENK As Long
                TEMPRENK = RENK
                
                For T = BEVELL To 0 Step -1
                    Ret = COLOR_LongToRGB(TEMPRENK).Red + BEVELDEPTHH
                    GRIN = COLOR_LongToRGB(TEMPRENK).Green + BEVELDEPTHH
                    BLU = COLOR_LongToRGB(TEMPRENK).Blue + BEVELDEPTHH
                    TEMPRENK = RGB(Ret, GRIN, BLU)
                    Line (T, T)-(ScaleWidth - (T + 1), ScaleHeight - (T + 1)), TEMPRENK, B
                Next T
                
                
                BEVELDEPTHH = BEVELDEPTHH * (-1)
                For T = BEVELL To 0 Step -1
                    RENK = COLOR_DarkenLightenColor(RENK, BEVELDEPTHH) 'RGB(Ret, GRIN, BLU)
                    Line (T, T)-(ScaleWidth - (T + 1), T), RENK
                    Line (T, T)-(T, ScaleHeight - (T + 1)), RENK
                Next T
End Sub
Private Sub RunShowBorderOnFocus(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
Dim T As Integer
            If BEVELL < 2 Then
                DRAWRECT hdc, 0, 0, ScaleWidth - 1, ScaleHeight - 1, g_Shadow
                DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, g_HighLight
                DRAWRECT hdc, -1, -1, ScaleWidth + 1, ScaleHeight + 1, g_DarkShadow
            Else
                RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH + 3
            End If
End Sub
Private Sub XPAdjustColorScheme()
If m_XPWinStyle And m_XPStyle Then Exit Sub
    If m_XPStyle = True Then
        If m_TransparentBG = True And Not g_MouseDown Then
            Transparentia
        Else
            UserControl.BackColor = m_BackColor
        End If
    Else
        If m_TransparentBG = True Then Transparentia
    End If


    
    'If XP then adjust colors:
    If m_XPStyle = True Then
        Dim l1 As Double
        Dim l2 As Double
        Dim l3 As Double
        Dim ll As Double
        Dim KOLOR As RGB
        l1 = 171
        l2 = 154
        l3 = 108
        ll = -15
        KOLOR = COLOR_LongToRGB(COLOR_UniColor(vbHighlight))
        If Not g_MouseDown And g_MouseIn Then 'Mouse Over but Not Pressed
                If XPDefaultColors = True Then
                   
                   UserControl.BackColor = RGB(KOLOR.Red + l1, KOLOR.Green + l2, _
                                                                    KOLOR.Blue + l3)
                Else 'Use user defined colors
                   UserControl.BackColor = XPColor_Hover
                End If
        End If
        
        If g_MouseDown Then   'Mouse Over and Pressed
                If XPDefaultColors = True Then
                    UserControl.BackColor = RGB(KOLOR.Red + l1 + ll, _
                                    KOLOR.Green + l2 + ll, KOLOR.Blue + l3)
                Else 'Use user defined colors
                    UserControl.BackColor = XPColor_Pressed
                End If
        End If
    End If
End Sub
Private Sub Draw3DEffect()
    If Not Ambient.UserMode Then
        If m_XPStyle = True Then
            If m_XPWinStyle = True Then
                DrawWinXPButton 0
            Else
                XPAdjustColorScheme
            End If
        Else
            If m_BEVEL < 2 Then
                DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, g_Shadow
                DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, g_HighLight
            Else
                RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
            End If
        End If
    End If
    
    
    
    If m_XPStyle = True Then
        If m_XPWinStyle = False Then
                If Not (XPShowBorderAlways = False And Not g_MouseIn) Then
                    DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, m_ForeColor
                End If
        Else
            If g_MouseDown Then DrawWinXPButton 2 'BASILDI
            If Not g_MouseDown And g_MouseIn Then DrawWinXPButton 0, True '躍T躈DE AMA BASILI DE休L
            If Not g_MouseDown And Not g_MouseIn Then DrawWinXPButton 0  'DI轆RDA
        End If
    Exit Sub
    End If
    
    'Devam:
        If g_MouseDown Then 'BASILDI
            If m_BEVEL < 2 Then
                DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, g_HighLight
                DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, g_Shadow
            Else
                RunXTRA3D_PRESSED COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
            End If
        End If
        If Not g_MouseDown And g_MouseIn Then '躍T躈DE AMA BASILI DE休L
            If m_BEVEL < 2 Then
                DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, g_Shadow
                DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, g_HighLight
            Else
                RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
            End If
        End If
        
        If Not g_MouseDown And Not g_MouseIn And m_Raised Then 'DI轆RDA 軸E VE RAISED 軸E
            If m_BEVEL < 2 Then
                DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, g_Shadow
                DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, g_HighLight
            Else
                RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
            End If
        End If
         'SHOW BORDER ON FOCUS
          If (g_HasFocus And m_ShowBorderOnFocus And m_Raised And Not g_MouseDown) Or Extender.Default Then
                    RunShowBorderOnFocus COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
         End If
End Sub
Private Sub OverTimer_Timer()
    Dim P As POINTAPI
    GetCursorPos P
    If hwnd <> WindowFromPoint(P.X, P.Y) Then
        OverTimer.Enabled = False
        g_MouseIn = False
        Set m_Picture = m_PictureOriginal
        RaiseEvent MouseOut(g_Shift)
        Refresh                     'Refresh picture
        If g_MouseDown = True Then  'Resfresh state
            g_MouseDown = False
            Refresh
            g_MouseDown = True
        End If
    End If
End Sub

Public Property Get RAISED() As Boolean
    RAISED = m_Raised
End Property

Public Property Let RAISED(ByVal New_Raised As Boolean)
    m_Raised = New_Raised
    PropertyChanged "Raised"
    Refresh
End Property

Public Sub GoToURL()
    'On Error Resume Next
    If Left(m_URL, 7) = "mailto:" Then
        Navigate UserControl.Parent, m_URL
        Exit Sub
    End If
        If Not m_URL = "" Then UserControl.Hyperlink.NavigateTo m_URL
End Sub
Private Sub Navigate(frm As Form, ByVal WebPageURL As String)
Dim hBrowse As Long
hBrowse = ShellExecute(frm.hwnd, "open", WebPageURL, "", "", 1)
End Sub
Public Property Get URL() As String
    URL = m_URL
End Property

Public Property Let URL(ByVal New_URL As String)
    m_URL = New_URL
    PropertyChanged "URL"
End Property

Public Property Get Caption() As String
    Caption = m_Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
    Refresh
End Property
Public Property Get PicturePosition() As XBPicturePosition
    PicturePosition = m_PicturePosition
End Property
Public Property Let PicturePosition(ByVal New_PicturePosition As XBPicturePosition)
    m_PicturePosition = New_PicturePosition
    PropertyChanged "PicturePosition"
    Refresh
End Property
Public Property Get Picture() As Picture
    Set Picture = m_Picture
End Property
Public Property Set Picture(ByVal New_Picture As Picture)
    Set m_Picture = New_Picture
    Set m_PictureOriginal = New_Picture
    If m_Picture Is Nothing Then
        m_OriginalPicSizeW = 32
        m_OriginalPicSizeH = 32
    Else
        m_OriginalPicSizeW = UserControl.ScaleX(m_Picture.Width, vbHimetric, UserControl.ScaleMode)
        m_OriginalPicSizeH = UserControl.ScaleY(m_Picture.Height, vbHimetric, UserControl.ScaleMode)
    End If
    PropertyChanged "Picture"
    If m_PictureSize = sizeDefault Then
        m_PictureWidth = UserControl.ScaleX(m_Picture.Width, vbHimetric, UserControl.ScaleMode)
        m_PictureHeight = UserControl.ScaleY(m_Picture.Height, vbHimetric, UserControl.ScaleMode)
    End If
    Refresh
End Property

Public Property Get PictureWidth() As Long
    PictureWidth = m_PictureWidth
End Property
Public Property Let PictureWidth(ByVal New_PictureWidth As Long)
    m_PictureWidth = New_PictureWidth
    PropertyChanged "PictureWidth"
    Refresh
End Property
Public Property Get PictureHeight() As Long
    PictureHeight = m_PictureHeight
End Property
Public Property Let PictureHeight(ByVal New_PictureHeight As Long)
    m_PictureHeight = New_PictureHeight
    PropertyChanged "PictureHeight"
    Refresh
End Property
Public Property Get PictureSize() As XBPictureSize
    PictureSize = m_PictureSize
End Property
Public Property Let PictureSize(ByVal New_PictureSize As XBPictureSize)
    m_PictureSize = New_PictureSize
    PropertyChanged "PictureSize"
    
    
    Select Case New_PictureSize
    Case size16x16
        m_PictureWidth = 16
        m_PictureHeight = 16
    Case size32x32
        m_PictureWidth = 32
        m_PictureHeight = 32
    Case sizeDefault
        If Not (m_Picture Is Nothing) Then
            m_PictureWidth = m_OriginalPicSizeW