gurhanbutton.ctl

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

    m_NoBorderEffect = PropBag.ReadProperty("NoBorderEffect", m_def_NoBorderEffect)
''''''    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    m_Raised = PropBag.ReadProperty("Raised", m_def_Raised)
    m_URL = PropBag.ReadProperty("URL", m_def_URL)
    m_XPStyle = PropBag.ReadProperty("XPStyle", m_def_XPStyle)
    m_XPColor_Pressed = PropBag.ReadProperty("XPColor_Pressed", m_def_XPColor_Pressed)
    m_XPColor_Hover = PropBag.ReadProperty("XPColor_Hover", m_def_XPColor_Hover)
    m_XPDefaultColors = PropBag.ReadProperty("XPDefaultColors", m_def_XPDefaultColors)
    
    m_SoundOver = PropBag.ReadProperty("SoundOver", m_def_SoundOver)
    m_SoundClick = PropBag.ReadProperty("SoundClick", m_def_SoundClick)
    m_DefCurHand = PropBag.ReadProperty("DefCurHand", m_def_DefCurHand)
    m_XPShowBorderAlways = PropBag.ReadProperty("XPShowBorderAlways", m_def_XPShowBorderAlways)
    m_MaskColor = PropBag.ReadProperty("MaskColor", m_def_MaskColor)
    m_TransparentBG = PropBag.ReadProperty("TransparentBG", m_def_TransparentBG)
    m_BEVEL = PropBag.ReadProperty("BEVEL", m_def_BEVEL)
    m_BEVELDEPTH = PropBag.ReadProperty("BEVELDEPTH", m_def_BEVELDEPTH)
    m_XPWinStyle = PropBag.ReadProperty("XPWinStyle", m_def_XPWinStyle)

UserControl_Resize
End Sub

Private Sub UserControl_Terminate()
    DeleteObject AreaOriginal
    Set g_Font = Nothing
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", m_Caption, Ambient.DisplayName)
    Call PropBag.WriteProperty("PicturePosition", m_PicturePosition, 1)
    Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
    Call PropBag.WriteProperty("PictureWidth", m_PictureWidth, 32)
    Call PropBag.WriteProperty("PictureHeight", m_PictureHeight, 32)
    Call PropBag.WriteProperty("PictureSize", m_PictureSize, 1)
    Call PropBag.WriteProperty("OriginalPicSizeW", m_OriginalPicSizeW, 32)
    Call PropBag.WriteProperty("OriginalPicSizeH", m_OriginalPicSizeH, 32)
    
    Call PropBag.WriteProperty("PictureHover", m_PictureHover, Nothing)
    
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("ShowBorderOnFocus", m_ShowBorderOnFocus, m_def_ShowBorderOnFocus)
    Call PropBag.WriteProperty("ShowFocusRect", m_ShowFocusRect, m_def_ShowFocusRect)
 
    Call PropBag.WriteProperty("Raised", m_Raised, m_def_Raised)
    Call PropBag.WriteProperty("URL", m_URL, m_def_URL)
    Call PropBag.WriteProperty("XPStyle", m_XPStyle, m_def_XPStyle)
    Call PropBag.WriteProperty("XPColor_Pressed", m_XPColor_Pressed, m_def_XPColor_Pressed)
    Call PropBag.WriteProperty("XPColor_Hover", m_XPColor_Hover, m_def_XPColor_Hover)
    Call PropBag.WriteProperty("XPDefaultColors", m_XPDefaultColors, m_def_XPDefaultColors)
    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
    
    Call PropBag.WriteProperty("SoundOver", m_SoundOver, m_def_SoundOver)
    Call PropBag.WriteProperty("SoundClick", m_SoundClick, m_def_SoundClick)
    Call PropBag.WriteProperty("NoBorderEffect", m_NoBorderEffect, m_def_NoBorderEffect)
    Call PropBag.WriteProperty("DefCurHand", m_DefCurHand, m_def_DefCurHand)
    Call PropBag.WriteProperty("XPShowBorderAlways", m_XPShowBorderAlways, m_def_XPShowBorderAlways)
    Call PropBag.WriteProperty("MaskColor", m_MaskColor, m_def_MaskColor)
    Call PropBag.WriteProperty("TransparentBG", m_TransparentBG, m_def_TransparentBG)
    Call PropBag.WriteProperty("BEVEL", m_BEVEL, m_def_BEVEL)
    Call PropBag.WriteProperty("BEVELDEPTH", m_BEVELDEPTH, m_def_BEVELDEPTH)
    Call PropBag.WriteProperty("XPWinStyle", m_XPWinStyle, m_def_XPWinStyle)
 End Sub
Private Sub CalcRECTs()
    Dim picWidth, picHeight, capWidth, capHeight As Long
    alan.Left = 0
    alan.Top = 0
    alan.Right = UserControl.ScaleWidth - 1
    alan.Bottom = UserControl.ScaleHeight - 1
    
    With mvarClientRect
     .Left = alan.Left + mvarPadding
     .Top = alan.Top + mvarPadding
     .Right = alan.Right - mvarPadding + 1
     .Bottom = alan.Bottom - mvarPadding + 1
    End With
    
    If m_Picture Is Nothing Then
        With mvarCaptionRect
           .Left = mvarClientRect.Left
           .Top = mvarClientRect.Top
           .Right = mvarClientRect.Right
           .Bottom = mvarClientRect.Bottom
        End With
        CalculateCaptionRect
    Else
        If m_Caption = "" Then
         With mvarPictureRect
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - m_PictureWidth) \ 2) + mvarClientRect.Left
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - m_PictureHeight) \ 2) + mvarClientRect.Top
            .Right = mvarPictureRect.Left + m_PictureWidth
            .Bottom = mvarPictureRect.Top + m_PictureHeight
         End With
            Exit Sub
        End If
        
        With mvarCaptionRect
        .Left = mvarClientRect.Left
        .Top = mvarClientRect.Top
        .Right = mvarClientRect.Right
        .Bottom = mvarClientRect.Bottom
        End With
        CalculateCaptionRect
        'Width and Height of the picture and the caption
        picWidth = m_PictureWidth
        picHeight = m_PictureHeight
        capWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
        capHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
        Select Case m_PicturePosition
        Case gbLEFT
            'final values for the picture and caption rectangles
        With mvarPictureRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
            .Bottom = mvarPictureRect.Top + picHeight
            .Right = mvarPictureRect.Left + picWidth
        End With
        With mvarCaptionRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
            .Left = mvarPictureRect.Right + mvarPadding
            .Bottom = mvarCaptionRect.Top + capHeight
            .Right = mvarCaptionRect.Left + capWidth
        End With
        
        Case gbRIGHT
            'final values for the picture and caption rectangles
        With mvarCaptionRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
            .Bottom = mvarCaptionRect.Top + capHeight
            .Right = mvarCaptionRect.Left + capWidth
        End With
        With mvarPictureRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
            .Left = mvarCaptionRect.Right + mvarPadding
            .Bottom = mvarPictureRect.Top + picHeight
            .Right = mvarPictureRect.Left + picWidth
        End With
        Case gbTOP
            'final values for the picture and caption rectangles
        With mvarPictureRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
            .Bottom = mvarPictureRect.Top + picHeight
            .Right = mvarPictureRect.Left + picWidth
        End With
        With mvarCaptionRect
            .Top = mvarPictureRect.Bottom + mvarPadding
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
            .Bottom = mvarCaptionRect.Top + capHeight
            .Right = mvarCaptionRect.Left + capWidth
        End With
        Case gbBOTTOM
            'final values for the picture and caption rectangles
        With mvarCaptionRect
            .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
            .Bottom = mvarCaptionRect.Top + capHeight
            .Right = mvarCaptionRect.Left + capWidth
        End With
        With mvarPictureRect
            .Top = mvarCaptionRect.Bottom + mvarPadding
            .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
            .Bottom = mvarPictureRect.Top + picHeight
            .Right = mvarPictureRect.Left + picWidth
        End With
        End Select
    End If
End Sub

Private Sub UserControl_Initialize()
    Set g_Font = New StdFont
    
    UserControl.ScaleMode = vbPixels
    UserControl.PaletteMode = vbPaletteModeContainer
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    If Not Me.Enabled Then Exit Sub
    If KeyAscii = 13 Or KeyAscii = 27 Then
        RaiseEvent Click
        GoToURL
    End If
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    Refresh 'Extender.Default changed
End Sub

Private Sub UserControl_EnterFocus()
    g_HasFocus = True
    Refresh
End Sub

Private Sub UserControl_ExitFocus()
    g_HasFocus = False
    g_MouseDown = False
    Refresh
End Sub

Private Sub UserControl_Resize()
    'Minimum size = 10 x 10 pixels
    If ScaleWidth < 10 Then UserControl.Width = 150
    If ScaleHeight < 10 Then UserControl.Height = 150
    
Gen = ScaleWidth
Yuk = ScaleHeight

    'Set focus rect:
    g_FocusRect.Left = 4
    g_FocusRect.Right = ScaleWidth - 4
    g_FocusRect.Top = 4
    g_FocusRect.Bottom = ScaleHeight - 4
    
    DeleteObject AreaOriginal
    If m_XPStyle And m_XPWinStyle Then
        RoundCorners
    End If
    Refresh
End Sub
Public Sub Refresh()
    AutoRedraw = True
    'Clearing everything
    UserControl.Cls
    XPAdjustColorScheme
    If m_NoBorderEffect = False Then Draw3DEffect
    'OK continue ...
    CalcRECTs
    DrawPicture
    If g_HasFocus And m_ShowFocusRect And m_XPWinStyle = False Then DrawFocusRect hdc, g_FocusRect
    DrawCaption
    AutoRedraw = False
End Sub

Private Sub UserControl_DblClick()
    SetCapture hwnd 'Preseve hWnd on DblClick
    UserControl_MouseDown g_Button, g_Shift, g_X, g_Y
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not g_KeyPressed Then ' Not continuous clicking
                             ' If you want it, remove this filter
                             ' ... or create a new property
        Select Case KeyCode
            Case vbKeyReturn
                RaiseEvent Click
                GoToURL
            Case vbKeySpace
                g_MouseDown = True
                Refresh
                RaiseEvent Click
                GoToURL
        End Select
        g_KeyPressed = True
    End If
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeySpace Then
        g_MouseDown = False
        Refresh
    End If
    g_KeyPressed = False
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    g_Button = Button: g_Shift = Shift: g_X = X: g_Y = Y
    If Button <> vbRightButton Then
        g_MouseDown = True
        Refresh
    End If
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (X >= 0 And Y >= 0) And (X < ScaleWidth And Y < ScaleHeight) Then
        If g_MouseIn = False Then
            OverTimer.Enabled = True
            g_MouseIn = True
            If Not m_PictureHover Is Nothing Then
                Set m_Picture = m_PictureHover
            End If
            RaiseEvent MouseIn(Shift)
            Refresh
            DoEvents
            Call PlayASound(SoundOver)
        End If
    End If
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    g_MouseDown = False
    If Button <> vbRightButton Then
        Refresh
        If (X >= 0 And Y >= 0) And (X < ScaleWidth And Y < ScaleHeight) Then
            Call PlayASound(SoundClick)
            RaiseEvent Click
            GoToURL
        End If
    End If
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    Refresh
End Property
Public Property Get Font() As Font
Attribute Font.VB_UserMemId = -512
    Set Font = g_Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    With g_Font
        .Name = New_Font.Name
        .Size = New_Font.Size
        .Bold = New_Font.Bold
        .Italic = New_Font.Italic
        .Underline = New_Font.Underline