xpcontainer.ctl

一款漂亮的闹钟制作界面,希望能给你们带来帮助.

            UserControl.Line (0, xx)-(UserControl.ScaleWidth, xx), RGB(Rx, Gx, Bx)
            Rx = Rx - Rs
            Gx = Gx - Gs
            Bx = Bx - Bs
        Next xx

    End If
    
ErrHandler:
    Exit Function
End Function

Private Function DrawBorder(lBorderColor As OLE_COLOR)

    On Error GoTo ErrHandler
    
    UserControl.Line (0, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), lBorderColor, B
    UserControl.Line (0, UserControl.ScaleHeight - 1)-(UserControl.ScaleWidth, UserControl.ScaleHeight - 1), lBorderColor
    UserControl.Line (UserControl.ScaleWidth - 1, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), lBorderColor
    
ErrHandler:
    Exit Function
End Function

Private Function DrawHeader(lLightColor As OLE_COLOR, _
                            lDarkColor As OLE_COLOR, _
                            lTextColor As OLE_COLOR)

    On Error GoTo ErrHandler
    
    Dim xx, R1, R2, G1, G2, B1, B2, Rs, Gs, Bs, Rx, Gx, Bx
    Dim lColor As Long, lColor2 As Long
    
    lColor = TranslateColor(lLightColor)
    lColor2 = TranslateColor(lDarkColor)
            
    R1 = GetRed(lColor): R2 = GetRed(lColor2)
    G1 = GetGreen(lColor): G2 = GetGreen(lColor2)
    B1 = GetBlue(lColor): B2 = GetBlue(lColor2)

    Rx = R1: Gx = G1: Bx = B1
    Rs = (R1 - R2) / (Picture1.ScaleHeight - 1)
    Gs = (G1 - G2) / (Picture1.ScaleHeight - 1)
    Bs = (B1 - B2) / (Picture1.ScaleHeight - 1)

    For xx = 0 To Picture1.ScaleHeight - 1
        Picture1.Line (0, xx)-(Picture1.ScaleWidth, xx), RGB(Rx, Gx, Bx)
        Rx = Rx - Rs
        Gx = Gx - Gs
        Bx = Bx - Bs
    Next xx
        
    Label1.ForeColor = lTextColor
        
ErrHandler:
    Exit Function
End Function


Private Function GetBlue(iColor As Long) As Integer
    GetBlue = ((iColor And &HFF0000) / 65536)
End Function
Private Function GetGreen(iColor As Long) As Integer
    GetGreen = ((iColor And &HFF00FF00) / 256&)
End Function

Private Function GetRed(iColor As Long) As Integer
    GetRed = iColor Mod 256
End Function


Private Sub RedrawControl()

    UserControl.Cls
    Label1.Caption = m_Caption
    
    If Style = [Header Visible] Then
        Picture1.Visible = True
        DrawHeader m_HeaderLightColor, m_HeaderDarkColor, m_TextColor
        DrawBackground m_BackLightColor, m_BackDarkColor
        DrawBorder m_BorderColor
    Else
        Picture1.Visible = False
        DrawBackground m_BackLightColor, m_BackDarkColor
        DrawBorder m_BorderColor
    End If
    
End Sub ' wssccc's qq  151884336


Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                                Optional hPal As Long = 0) As Long

    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If

End Function

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage mhwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0

End Sub ' wssccc's qq  151884336

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage mhwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0

End Sub ' wssccc's qq  151884336


Private Sub UserControl_Initialize()
    m_hMod = LoadLibrary("shell32.dll")
End Sub ' wssccc's qq  151884336

Private Sub UserControl_InitProperties()
    m_HeaderLightColor = m_def_HeaderLightColor
    m_HeaderDarkColor = m_def_HeaderDarkColor
    m_BackLightColor = m_def_BackLightColor
    m_BackDarkColor = m_def_BackDarkColor
    m_BorderColor = m_def_BorderColor
    m_TextColor = m_def_TextColor
    m_Caption = m_def_Caption
    m_Style = m_def_Style
    m_Theme = m_def_Theme
End Sub ' wssccc's qq  151884336



Private Sub UserControl_Paint()
    RedrawControl
End Sub ' wssccc's qq  151884336


Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_HeaderLightColor = PropBag.ReadProperty("HeaderLightColor", m_def_HeaderLightColor)
    m_HeaderDarkColor = PropBag.ReadProperty("HeaderDarkColor", m_def_HeaderDarkColor)
    m_BackLightColor = PropBag.ReadProperty("BackLightColor", m_def_BackLightColor)
    m_BackDarkColor = PropBag.ReadProperty("BackDarkColor", m_def_BackDarkColor)
    m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
    m_TextColor = PropBag.ReadProperty("TextColor", m_def_TextColor)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    m_Theme = PropBag.ReadProperty("Theme", m_def_Theme)
End Sub ' wssccc's qq  151884336


Private Sub UserControl_Resize()

    If UserControl.Width <> 0 Then
        Label1.Top = (Picture1.ScaleHeight - Label1.Height) / 2
        Picture1.Width = UserControl.ScaleWidth - 2
        Picture2.Width = Picture1.Width
        Picture2.Height = UserControl.ScaleHeight - (Picture1.Height + 2)
    End If
    
    RedrawControl

End Sub ' wssccc's qq  151884336

Private Sub UserControl_Show()
    UserControl_Resize
End Sub ' wssccc's qq  151884336

Private Sub UserControl_Terminate()
    FreeLibrary m_hMod
End Sub ' wssccc's qq  151884336


Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("HeaderLightColor", m_HeaderLightColor, m_def_HeaderLightColor)
    Call PropBag.WriteProperty("HeaderDarkColor", m_HeaderDarkColor, m_def_HeaderDarkColor)
    Call PropBag.WriteProperty("BackLightColor", m_BackLightColor, m_def_BackLightColor)
    Call PropBag.WriteProperty("BackDarkColor", m_BackDarkColor, m_def_BackDarkColor)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
    Call PropBag.WriteProperty("TextColor", m_TextColor, m_def_TextColor)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    Call PropBag.WriteProperty("Theme", m_Theme, m_def_Theme)
End Sub ' wssccc's qq  151884336

Public Property Get BackDarkColor() As OLE_COLOR
    BackDarkColor = m_BackDarkColor
End Property

Public Property Let BackDarkColor(ByVal New_BackDarkColor As OLE_COLOR)
    m_BackDarkColor = New_BackDarkColor
    PropertyChanged "BackDarkColor"
    RedrawControl
End Property

Public Property Get BackLightColor() As OLE_COLOR
    BackLightColor = m_BackLightColor
End Property

Public Property Let BackLightColor(ByVal New_BackLightColor As OLE_COLOR)
    m_BackLightColor = New_BackLightColor
    PropertyChanged "BackLightColor"
    RedrawControl
End Property

Public Property Get BorderColor() As OLE_COLOR
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
    m_BorderColor = New_BorderColor
    PropertyChanged "BorderColor"
    RedrawControl
End Property

Public Function ShowAbout()
MsgBox "cccssw&wssccc无敌!", vbInformation, "嘿~"
End Function

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"
    RedrawControl
End Property

Public Property Get HeaderDarkColor() As OLE_COLOR
    HeaderDarkColor = m_HeaderDarkColor
End Property

Public Property Let HeaderDarkColor(ByVal New_HeaderDarkColor As OLE_COLOR)
    m_HeaderDarkColor = New_HeaderDarkColor
    PropertyChanged "HeaderDarkColor"
    RedrawControl
End Property

Public Property Get HeaderLightColor() As OLE_COLOR
    HeaderLightColor = m_HeaderLightColor
End Property

Public Property Let HeaderLightColor(ByVal New_HeaderLightColor As OLE_COLOR)
    m_HeaderLightColor = New_HeaderLightColor
    PropertyChanged "HeaderLightColor"
    RedrawControl
End Property

Public Property Get Style() As XPContainerStyles
    Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As XPContainerStyles)
    m_Style = New_Style
    PropertyChanged "Style"
    RedrawControl
End Property

Public Property Get TextColor() As OLE_COLOR
    TextColor = m_TextColor
End Property

Public Property Let TextColor(ByVal New_TextColor As OLE_COLOR)
    m_TextColor = New_TextColor
    PropertyChanged "TextColor"
    RedrawControl
End Property

Public Property Get Theme() As XPContainerThemes
    Theme = m_Theme
End Property

Public Property Let Theme(ByVal New_Theme As XPContainerThemes)
    m_Theme = New_Theme
    PropertyChanged "Theme"
    ApplyTheme
End Property


Public Property Get hhhw() As Variant

End Property

Public Property Let hhhw(ByVal vNewValue As Variant)
mhwnd = vNewValue
End Property