mybutton.ctl

用Delphi写的网络聊天工具

                        DrawText hDC, m_Text, TextRect, Align
                        TextRect = ModifyRect(TextRect, -1, -1, -1, -1)
                    End If
                End If

                UserControl.ForeColor = m_TextColorDisabled
                If bDrawText Then
                    DrawText hDC, m_Text, TextRect, Align
                End If
            Else
                'draw text and picture enabled
                UserControl.ForeColor = m_TextColorEnabled
                If bDrawText Then
                    DrawText hDC, m_Text, TextRect, Align
                End If
                DrawPicture hDC, m_Picture, PicX, PicY, PicW, PicH, m_PictureTColor
            End If
        End If

    Dim F As Long
    If m_DrawFocus > 0 Then
        If State = BTN_DOWN Or State = BTN_FOCUS Then
            F = CLng(m_DrawFocus)
            DrawFocusRect hDC, SetRect(F, F, dw - F, DH - F)
        End If
    End If

    UserControl.ForeColor = PColor
    If UserControl.AutoRedraw = True Then
        UserControl.Refresh
    End If
Exit Sub
UnknownError:

'most important line in this function
'i about 2 hours to find out
Set m_SkinPicture = Nothing
'removing this line form will not unload properly
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get FillWithColor() As Boolean
Attribute FillWithColor.VB_Description = "Middle area of button is filled with color if true or tiled with skin."
Attribute FillWithColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    FillWithColor = m_FillWithColor
End Property

Public Property Let FillWithColor(ByVal New_FillWithColor As Boolean)
    m_FillWithColor = New_FillWithColor
    Refresh
    PropertyChanged "FillWithColor"
End Property


Public Sub Refresh()

    If m_State < 1 Or m_State > 5 Then m_State = 1
    If Enabled Then
        DrawButton m_State
    Else
        DrawButton BTN_DISABLED
    End If
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hWnd
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
    hWnd = UserControl.hWnd
End Property
 
Private Function PointInControl(X As Single, Y As Single) As Boolean
  If X >= 0 And X <= UserControl.ScaleWidth And _
    Y >= 0 And Y <= UserControl.ScaleHeight Then
    PointInControl = True
  End If
End Function

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled

    If New_Enabled Then
        DrawButton BTN_NORMAL
    Else
        DrawButton BTN_DISABLED
    End If
    
    PropertyChanged "Enabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TextColorEnabled() As Ole_Color
Attribute TextColorEnabled.VB_Description = "Color of text when its enabled."
Attribute TextColorEnabled.VB_ProcData.VB_Invoke_Property = ";Appearance"
    TextColorEnabled = m_TextColorEnabled
End Property

Public Property Let TextColorEnabled(ByVal New_TextColorEnabled As Ole_Color)
    m_TextColorEnabled = New_TextColorEnabled
    Refresh
    PropertyChanged "TextColorEnabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TextColorDisabled() As Ole_Color
Attribute TextColorDisabled.VB_Description = "Color of text when button is disabled"
Attribute TextColorDisabled.VB_ProcData.VB_Invoke_Property = ";Appearance"
    TextColorDisabled = m_TextColorDisabled
End Property

Public Property Let TextColorDisabled(ByVal New_TextColorDisabled As Ole_Color)
    m_TextColorDisabled = New_TextColorDisabled
    Refresh
    PropertyChanged "TextColorDisabled"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    Refresh
    PropertyChanged "Font"
End Property



'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontUnderline
Public Property Get FontUnderline() As Boolean
Attribute FontUnderline.VB_Description = "Returns/sets underline font styles."
Attribute FontUnderline.VB_ProcData.VB_Invoke_Property = ";Font"
    FontUnderline = UserControl.FontUnderline
End Property

Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
    UserControl.FontUnderline() = New_FontUnderline
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontStrikethru
Public Property Get FontStrikethru() As Boolean
Attribute FontStrikethru.VB_Description = "Returns/sets strikethrough font styles."
Attribute FontStrikethru.VB_ProcData.VB_Invoke_Property = ";Font"
    FontStrikethru = UserControl.FontStrikethru
End Property

Public Property Let FontStrikethru(ByVal New_FontStrikethru As Boolean)
    UserControl.FontStrikethru() = New_FontStrikethru
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontSize
Public Property Get FontSize() As Single
Attribute FontSize.VB_Description = "Specifies the size (in points) of the font that appears in each row for the given level."
Attribute FontSize.VB_ProcData.VB_Invoke_Property = ";Font"
    FontSize = UserControl.FontSize
End Property

Public Property Let FontSize(ByVal New_FontSize As Single)
    UserControl.FontSize() = New_FontSize
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontName
Public Property Get FontName() As String
Attribute FontName.VB_Description = "Specifies the name of the font that appears in each row for the given level."
Attribute FontName.VB_ProcData.VB_Invoke_Property = ";Font"
    FontName = UserControl.FontName
End Property

Public Property Let FontName(ByVal New_FontName As String)
    UserControl.FontName() = New_FontName
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontItalic
Public Property Get FontItalic() As Boolean
Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
Attribute FontItalic.VB_ProcData.VB_Invoke_Property = ";Font"
    FontItalic = UserControl.FontItalic
End Property

Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
    UserControl.FontItalic() = New_FontItalic
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontBold
Public Property Get FontBold() As Boolean
Attribute FontBold.VB_Description = "Returns/sets bold font styles."
Attribute FontBold.VB_ProcData.VB_Invoke_Property = ";Font"
    FontBold = UserControl.FontBold
End Property

Public Property Let FontBold(ByVal New_FontBold As Boolean)
    UserControl.FontBold() = New_FontBold
    Refresh
    PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MousePointer
Public Property Get MousePointer() As MousePointerConstants
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
    MousePointer = UserControl.MousePointer
End Property

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

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MouseIcon
Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,False
Public Property Get DisableHover() As Boolean
Attribute DisableHover.VB_ProcData.VB_Invoke_Property = ";Behavior"
    DisableHover = m_DisableHover
End Property

Public Property Let DisableHover(ByVal New_DisableHover As Boolean)
    m_DisableHover = New_DisableHover
    PropertyChanged "DisableHover"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get DisplaceText() As Integer
Attribute DisplaceText.VB_Description = "Displaces text when button is down."
Attribute DisplaceText.VB_ProcData.VB_Invoke_Property = ";Behavior"
    DisplaceText = m_DisplaceText
End Property

Public Property Let DisplaceText(ByVal New_DisplaceText As Integer)
    m_DisplaceText = New_DisplaceText
    PropertyChanged "DisplaceText"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get DrawFocus() As Integer
Attribute DrawFocus.VB_Description = "Draws focus."
Attribute DrawFocus.VB_ProcData.VB_Invoke_Property = ";Appearance"
    DrawFocus = m_DrawFocus
End Property

Public Property Let DrawFocus(ByVal New_DrawFocus As Integer)
    m_DrawFocus = New_DrawFocus
    PropertyChanged "DrawFocus"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get TextColorDisabled2() As Ole_Color
Attribute TextColorDisabled2.VB_Description = "Color of text when button is disabled that make it looks grayed."
Attribute TextColorDisabled2.VB_ProcData.VB_Invoke_Property = ";Appearance"
    TextColorDisabled2 = m_TextColorDisabled2
End Property

Public Property Let TextColorDisabled2(ByVal New_TextColorDisabled2 As Ole_Color)
    m_TextColorDisabled2 = New_TextColorDisabled2
    Refresh
    PropertyChanged "TextColorDisabled2"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,0,0,0
Public Property Get Picture() As StdPicture
Attribute Picture.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Set Picture = m_Picture
End Property

Public Property Set Picture(ByVal New_Picture As StdPicture)
    Set m_Picture = New_Picture
    Refresh
    PropertyChanged "Picture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get PicturePos() As EnumPicturePos
Attribute PicturePos.VB_ProcData.VB_Invoke_Property = ";Appearance"
    PicturePos = m_PicturePos
End Property

Public Property Let PicturePos(ByVal New_PicturePos As EnumPicturePos)
    m_PicturePos = New_PicturePos
    Refresh
    PropertyChanged "PicturePos"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get PictureTColor() As Ole_Color
Attribute PictureTColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    PictureTColor = m_PictureTColor
End Property

Public Property Let PictureTColor(ByVal New_PictureTColor As Ole_Color)
    m_PictureTColor = New_PictureTColor
    Refresh
    PropertyChanged "PictureTColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=8,0,0,0
Public Property Get TextAlign() As AlignmentConstants
Attribute TextAlign.VB_ProcData.VB_Invoke_Property = ";Appearance"
    TextAlign = m_TextAlign
End Property

Public Property Let TextAlign(ByVal New_TextAlign As AlignmentConstants)
    m_TextAlign = New_TextAlign
    Refresh
    PropertyChanged "TextAlign"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
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."
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As Ole_Color)
    UserControl.BackColor() = New_BackColor
    Refresh
    PropertyChanged "BackColor"
End Property