colorpicker.ctl

文件传送

    Call OleTranslateColor(vbGrayText, ByVal 0&, Clr)
    Brsh = CreateSolidBrush(Clr)
    Call FrameRect(hdc, RClr, Brsh)
    Call DeleteObject(Brsh)
    Call DeleteObject(Clr)
    
    'Draw focus
    If m_Appearance = [3D] Then
        Call SetRect(Rct, 6, 6, rx - 19, by - 6)
    Else
        Call SetRect(Rct, 5, 5, rx - 19, by - 5)
    End If
    If IsInFocus Then Call DrawFocusRect(hdc, Rct)
    
    Refresh
End Sub

Private Sub ShowPalette()
    Dim ClrCtrlPos As RECT
    
    Call GetWindowRect(hwnd, ClrCtrlPos)
    
    DefClr = m_DefaultColor
    CurClr = m_Color
    
    DefCap = m_DefaultCaption
    MorCap = m_MoreColorsCaption
    
    ShwDef = m_ShowDefault
    ShwMor = m_ShowMoreColors
    ShwCus = m_ShowCustomColors
    ShwSys = m_ShowSysColorButton
    ShwTip = m_ShowToolTips

    Load frmColorPalette
    With frmColorPalette
        .Left = ClrCtrlPos.Left * Screen.TwipsPerPixelX
        .Top = ClrCtrlPos.Bottom * Screen.TwipsPerPixelY
        If (.Top + .Height) > Screen.Height Then
            .Top = ClrCtrlPos.Top * Screen.TwipsPerPixelY - .Height
        End If
        
        .Show vbModal
        
        If Not .IsCanceled Then m_Color = .SelectedColor
        Call RedrawControl
    End With
    Unload frmColorPalette
End Sub



'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_DefaultColor = m_def_DefaultColor
    m_Color = m_def_Color
    m_Appearance = m_def_Appearance
    m_BackColor = m_def_BackColor
    m_ShowDefault = m_def_ShowDefault
    m_ShowCustomColors = m_def_ShowCustomColors
    m_ShowMoreColors = m_def_ShowMoreColors
    m_DefaultCaption = m_def_DefaultCaption
    m_MoreColorsCaption = m_def_MoreColorsCaption
    m_ShowSysColorButton = m_def_ShowSysColorButton
    m_ShowToolTips = m_def_ShowToolTips
    
    Height = 315
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_DefaultColor = PropBag.ReadProperty("默认颜色", m_def_DefaultColor)
    m_Color = PropBag.ReadProperty("颜色值", m_def_Color)
    m_Appearance = PropBag.ReadProperty("外观", m_def_Appearance)
    m_BackColor = PropBag.ReadProperty("背景色", m_def_BackColor)
    m_ShowDefault = PropBag.ReadProperty("显示默认", m_def_ShowDefault)
    m_ShowCustomColors = PropBag.ReadProperty("显示自定义色", m_def_ShowCustomColors)
    m_ShowMoreColors = PropBag.ReadProperty("显示更多颜色", m_def_ShowMoreColors)
    m_DefaultCaption = PropBag.ReadProperty("默认标题", m_def_DefaultCaption)
    m_MoreColorsCaption = PropBag.ReadProperty("更多颜色标题", m_def_MoreColorsCaption)
    m_ShowSysColorButton = PropBag.ReadProperty("显示系统颜色按钮", m_def_ShowSysColorButton)
    m_ShowToolTips = PropBag.ReadProperty("显示浮动提示", m_def_ShowToolTips)
    
    Call RedrawControl
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("默认颜色", m_DefaultColor, m_def_DefaultColor)
    Call PropBag.WriteProperty("颜色值", m_Color, m_def_Color)
    Call PropBag.WriteProperty("外观", m_Appearance, m_def_Appearance)
    Call PropBag.WriteProperty("背景色", m_BackColor, m_def_BackColor)
    Call PropBag.WriteProperty("显示默认", m_ShowDefault, m_def_ShowDefault)
    Call PropBag.WriteProperty("显示自定义色", m_ShowCustomColors, m_def_ShowCustomColors)
    Call PropBag.WriteProperty("显示更多颜色", m_ShowMoreColors, m_def_ShowMoreColors)
    Call PropBag.WriteProperty("默认标题", m_DefaultCaption, m_def_DefaultCaption)
    Call PropBag.WriteProperty("更多颜色标题", m_MoreColorsCaption, m_def_MoreColorsCaption)
    Call PropBag.WriteProperty("显示系统颜色按钮", m_ShowSysColorButton, m_def_ShowSysColorButton)
    Call PropBag.WriteProperty("显示浮动提示", m_ShowToolTips, m_def_ShowToolTips)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H00FFFFFF&
Public Property Get DefaultColor() As OLE_COLOR
Attribute DefaultColor.VB_Description = "Returns/Sets  the default color"
Attribute DefaultColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
    DefaultColor = m_DefaultColor
End Property

Public Property Let DefaultColor(ByVal New_DefaultColor As OLE_COLOR)
    m_DefaultColor = New_DefaultColor
    PropertyChanged "默认颜色"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H00FFFFFF&
Public Property Get Color() As OLE_COLOR
Attribute Color.VB_Description = "Returns/Sets the selected color"
Attribute Color.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute Color.VB_UserMemId = 0
    Color = m_Color
End Property

Public Property Let Color(ByVal New_Color As OLE_COLOR)
    m_Color = New_Color
    PropertyChanged "Value"
    
    Call RedrawControl
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,cpAppearanceConstants.[3D]
Public Property Get Appearance() As cpAppearanceConstants
Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
Attribute Appearance.VB_ProcData.VB_Invoke_Property = ";Appearance"
    Appearance = m_Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As cpAppearanceConstants)
    m_Appearance = New_Appearance
    PropertyChanged "Appearance"
    
    Call RedrawControl
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H8000000C&
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 = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    m_BackColor = New_BackColor
    PropertyChanged "BackColor"
    
    Call RedrawControl
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get ShowDefault() As Boolean
Attribute ShowDefault.VB_Description = "Returns/Sets whether default button will be shown or not"
Attribute ShowDefault.VB_ProcData.VB_Invoke_Property = ";Behavior"
    ShowDefault = m_ShowDefault
End Property

Public Property Let ShowDefault(ByVal New_ShowDefault As Boolean)
    m_ShowDefault = New_ShowDefault
    PropertyChanged "ShowDefault"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get ShowCustomColors() As Boolean
Attribute ShowCustomColors.VB_Description = "Returns/Sets whether custom colors will be shown or not"
Attribute ShowCustomColors.VB_ProcData.VB_Invoke_Property = ";Behavior"
    ShowCustomColors = m_ShowCustomColors
End Property

Public Property Let ShowCustomColors(ByVal New_ShowCustomColors As Boolean)
    m_ShowCustomColors = New_ShowCustomColors
    PropertyChanged "ShowCustomColors"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get ShowMoreColors() As Boolean
Attribute ShowMoreColors.VB_Description = "Returns/Sets whether More Colors button will be shown or not"
Attribute ShowMoreColors.VB_ProcData.VB_Invoke_Property = ";Behavior"
    ShowMoreColors = m_ShowMoreColors
End Property

Public Property Let ShowMoreColors(ByVal New_ShowMoreColors As Boolean)
    m_ShowMoreColors = New_ShowMoreColors
    PropertyChanged "ShowMoreColors"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,Default
Public Property Get DefaultCaption() As String
Attribute DefaultCaption.VB_Description = "Returns/Sets the caption in default button"
Attribute DefaultCaption.VB_ProcData.VB_Invoke_Property = ";Appearance"
    DefaultCaption = m_DefaultCaption
End Property

Public Property Let DefaultCaption(ByVal New_DefaultCaption As String)
    m_DefaultCaption = New_DefaultCaption
    PropertyChanged "DefaultCaption"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,More Colors...
Public Property Get MoreColorsCaption() As String
Attribute MoreColorsCaption.VB_Description = "Returns/Sets the caption in the More button"
Attribute MoreColorsCaption.VB_ProcData.VB_Invoke_Property = ";Appearance"
    MoreColorsCaption = m_MoreColorsCaption
End Property

Public Property Let MoreColorsCaption(ByVal New_MoreColorsCaption As String)
    m_MoreColorsCaption = New_MoreColorsCaption
    PropertyChanged "MoreColorsCaption"
End Property

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

Public Property Let ShowSysColorButton(ByVal New_ShowSysColorButton As Boolean)
    m_ShowSysColorButton = New_ShowSysColorButton
    PropertyChanged "ShowSysColorButton"
End Property

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

Public Property Let ShowToolTips(ByVal New_ShowToolTips As Boolean)
    m_ShowToolTips = New_ShowToolTips
    PropertyChanged "ShowToolTips"
End Property