gurhanbutton.ctl

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

            m_PictureHeight = m_OriginalPicSizeH
        Else
            m_PictureWidth = 32
            m_PictureHeight = 32
        End If
    End Select
    Refresh
End Property

Private Sub CalculateCaptionRect()
    Dim mvarWidth, mvarHeight As Long
    Dim mvarFormat As Long
    With mvarDrawTextParams
        .iLeftMargin = 1
        .iRightMargin = 1
        .iTabLength = 1
        .cbSize = Len(mvarDrawTextParams)
    End With
    mvarFormat = &H400 Or &H10 Or &H4 Or &H1
    DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), mvarCaptionRect, mvarFormat, mvarDrawTextParams
    mvarWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
    mvarHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
    With mvarCaptionRect
        .Left = mvarClientRect.Left + (((mvarClientRect.Right - mvarClientRect.Left) - (mvarCaptionRect.Right - mvarCaptionRect.Left)) \ 2)
        .Top = mvarClientRect.Top + (((mvarClientRect.Bottom - mvarClientRect.Top) - (mvarCaptionRect.Bottom - mvarCaptionRect.Top)) \ 2)
        .Right = mvarCaptionRect.Left + mvarWidth
        .Bottom = mvarCaptionRect.Top + mvarHeight
    End With
End Sub

Private Sub DrawCaption()
    If m_Caption = "" Then Exit Sub
    
    SetTextColor hdc, COLOR_UniColor(m_ForeColor)
    
    Dim mvarForeColor As OLE_COLOR
    mvarTempRect = mvarCaptionRect
    If g_MouseDown Then
       With mvarCaptionRect
        .Left = mvarCaptionRect.Left + 1
        .Top = mvarCaptionRect.Top + 1
        .Right = mvarCaptionRect.Right + 1
        .Bottom = mvarCaptionRect.Bottom + 1
       End With
    End If
    
    If Not Enabled Then
        Dim g_tmpFontColor As OLE_COLOR
        g_tmpFontColor = UserControl.ForeColor
        
        'A荌K DISABLED YAZI
        SetTextColor hdc, COLOR_UniColor(g_HighLight)
        Dim mvarCaptionRect_Iki As RECT
        With mvarCaptionRect_Iki
            .Bottom = mvarCaptionRect.Bottom
            .Left = mvarCaptionRect.Left + 1
            .Right = mvarCaptionRect.Right + 1
            .Top = mvarCaptionRect.Top + 1
        End With
        DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), mvarCaptionRect_Iki, &H10 Or &H4 Or &H1, mvarDrawTextParams
        
        'KOYU DISABLED YAZI
        SetTextColor hdc, COLOR_UniColor(g_Shadow)
        DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
        
        'Normale 鏴vir
        SetTextColor hdc, COLOR_UniColor(g_tmpFontColor)
        Exit Sub
    End If
    DrawTextEx UserControl.hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
    mvarCaptionRect = mvarTempRect
End Sub
Private Sub DrawBitmap(EnabledPic As Boolean, CurPictRECT As RECT)
Dim DC1 As Long
Dim BM1 As Long
Dim DC2 As Long
Dim BM2 As Long
Dim UZUN1 As Long
Dim UZUN2 As Long

DC1 = CreateCompatibleDC(hdc)
DC2 = CreateCompatibleDC(hdc)
BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
UZUN1 = SelectObject(DC1, BM1)
UZUN2 = SelectObject(DC2, BM2)

If Not EnabledPic Then 'DISABLED BITMAP
                Dim DC3 As Long
                Dim BM3 As Long
                
                DC3 = CreateCompatibleDC(hdc)
                BM3 = SelectObject(DC3, m_Picture.Handle)
                
                SetBkColor DC1, vbWhite
                 
                DRAWRECT DC1, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH, vbWhite, True

                TransParentPic DC1, DC1, DC3, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH, 0, 0, m_MaskColor
                
                StretchBlt DC2, 0, 0, _
                    m_PictureWidth, _
                        m_PictureHeight, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                
                SelectObject DC2, UZUN2
                Call DrawState(hdc, 0, 0, BM2, 0, CurPictRECT.Left, _
                             CurPictRECT.Top, 0, 0, _
                    DSS_DISABLED Or DST_BITMAP)

                
'    SelectObject DC3, UZUN3
    DeleteObject BM3
    DeleteDC DC3
                
Else 'ENABLED BITMAP
                
                Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
                    DSS_ENABLED Or DST_BITMAP)
            
                StretchBlt DC2, 0, 0, _
                    m_PictureWidth, _
                        m_PictureHeight, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                            
                TransParentPic hdc, hdc, DC2, 0, 0, _
                    m_PictureWidth, m_PictureHeight, _
                     CurPictRECT.Left, CurPictRECT.Top, m_MaskColor
                
End If

    SelectObject DC1, UZUN1
    SelectObject DC2, UZUN2
    DeleteObject BM1
    DeleteObject BM2
    DeleteDC DC1
    DeleteDC DC2
End Sub
Private Sub DrawPIcon(EnabledPic As Boolean, CurPictRECT As RECT)
If Not EnabledPic Then 'DISABLED ICON
                Dim DC1 As Long
                Dim BM1 As Long
                Dim DC2 As Long
                Dim BM2 As Long
                Dim UZUN1 As Long
                Dim UZUN2 As Long
                
                DC1 = CreateCompatibleDC(hdc)
                BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
            
                DC2 = CreateCompatibleDC(hdc)
                BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
            
                UZUN1 = SelectObject(DC1, BM1)
                UZUN2 = SelectObject(DC2, BM2)
                
                Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
                    DSS_DISABLED Or DST_ICON)
            
                StretchBlt DC2, 0, 0, _
                    CurPictRECT.Right - CurPictRECT.Left, _
                        CurPictRECT.Bottom - CurPictRECT.Top, _
                            DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
                            
                TransParentPic hdc, hdc, DC2, 0, 0, _
                    m_PictureWidth, m_PictureHeight, _
                      CurPictRECT.Left, CurPictRECT.Top, vbBlack
                
                SelectObject DC1, UZUN1
                SelectObject DC2, UZUN2
                DeleteObject BM1
                DeleteObject BM2
                DeleteDC DC1
                DeleteDC DC2

Else 'ENABLED ICON
'I should be changing this to BitBlt function since the method below
'is the cheapest and the slowest way to do it :)
            UserControl.PaintPicture m_Picture, CurPictRECT.Left, _
                CurPictRECT.Top, CurPictRECT.Right - CurPictRECT.Left, _
                  CurPictRECT.Bottom - CurPictRECT.Top, 0, 0, _
                    m_OriginalPicSizeW, m_OriginalPicSizeH
End If
End Sub

Private Sub DrawPicture()
    If m_Picture Is Nothing Then Exit Sub
    mvarTempRect = mvarPictureRect
    If g_MouseDown Then
        With mvarPictureRect
            .Left = mvarPictureRect.Left + 1
            .Top = mvarPictureRect.Top + 1
            .Right = mvarPictureRect.Right + 1
            .Bottom = mvarPictureRect.Bottom + 1
        End With
    End If

    Select Case m_Picture.Type
        Case vbPicTypeBitmap
            If Not Enabled Then 'BITMAP DISABLED
                DrawBitmap False, mvarPictureRect
            Else ' BITMAP ENABLED:
                DrawBitmap True, mvarPictureRect
            End If
        Case vbPicTypeIcon
            If Not Enabled Then
                DrawPIcon False, mvarPictureRect
            Else
                DrawPIcon True, mvarPictureRect
            End If
    End Select

mvarPictureRect = mvarTempRect
End Sub
Private Sub Transparentia()
  On Error Resume Next
Dim RESIM As StdPicture
Dim mem_dc As Long
Dim mem_bm As Long
Dim orig_bm As Long
Dim wid As Long
Dim hgt As Long
Dim IX As Long
Dim YE As Long

'We need to convert the scalemode since the parent's scalemode
'might be different from that of the usercontrol.
IX = ScaleX(Extender.Left, Parent.ScaleMode, ScaleMode)
YE = ScaleY(Extender.Top, Parent.ScaleMode, ScaleMode)

Set RESIM = Parent.Picture
    mem_dc = CreateCompatibleDC(hdc)
    mem_bm = CreateCompatibleBitmap(mem_dc, ScaleWidth, ScaleHeight)
    
    SelectObject mem_dc, RESIM.Handle
    
    BitBlt hdc, 0, 0, ScaleWidth, ScaleHeight, _
        mem_dc, IX, YE, vbSrcCopy
    
    ' Delete the bitmap and dc.
    SelectObject mem_dc, orig_bm
    DeleteObject mem_bm
    DeleteDC mem_dc
    Set RESIM = Nothing
End Sub

Public Property Get PictureHover() As Picture
    Set PictureHover = m_PictureHover
End Property

Public Property Set PictureHover(ByVal New_PictureHover As Picture)
    Set m_PictureHover = New_PictureHover
    PropertyChanged "PictureHover"
End Property
Public Property Get XPStyle() As Boolean
    XPStyle = m_XPStyle
End Property

Public Property Let XPStyle(ByVal New_XPStyle As Boolean)
    m_XPStyle = New_XPStyle
    PropertyChanged "XPStyle"
    Refresh
End Property
Public Property Get XPColor_Pressed() As OLE_COLOR
    XPColor_Pressed = m_XPColor_Pressed
End Property

Public Property Let XPColor_Pressed(ByVal New_XPColor_Pressed As OLE_COLOR)
    m_XPColor_Pressed = New_XPColor_Pressed
    PropertyChanged "XPColor_Pressed"
End Property
Public Property Get XPColor_Hover() As OLE_COLOR
    XPColor_Hover = m_XPColor_Hover
End Property

Public Property Let XPColor_Hover(ByVal New_XPColor_Hover As OLE_COLOR)
    m_XPColor_Hover = New_XPColor_Hover
    PropertyChanged "XPColor_Hover"
End Property
Public Property Get XPDefaultColors() As Boolean
    XPDefaultColors = m_XPDefaultColors
End Property
Public Property Let XPDefaultColors(ByVal New_XPDefaultColors As Boolean)
    m_XPDefaultColors = New_XPDefaultColors
    PropertyChanged "XPDefaultColors"
End Property
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = m_BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
    UserControl.BackColor = m_BackColor
    Refresh
End Property
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = m_ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    m_ForeColor = New_ForeColor
    PropertyChanged "ForeColor"
    UserControl.ForeColor = m_ForeColor
    Refresh
End Property
Public Property Get SoundOver() As Variant
    SoundOver = m_SoundOver
End Property
Public Property Let SoundOver(ByVal New_SoundOver As Variant)
    m_SoundOver = New_SoundOver
    PropertyChanged "SoundOver"
End Property
Public Property Get SoundClick() As String
    SoundClick = m_SoundClick
End Property
Public Property Let SoundClick(ByVal New_SoundClick As String)
    m_SoundClick = New_SoundClick
    PropertyChanged "SoundClick"
End Property
Public Property Get version() As String
Attribute version.VB_Description = "FileVersion"
    version = UserControl.Tag
End Property
Public Property Let version(ByVal New_version As String)
End Property
Private Function PlayASound(SoundFile As String) As Boolean
    Dim bSuccess As Boolean
    'ESK