wwcheckbox.ctl

磁盘FAT扇区数据读写操作 Ver 1.20(更新版)

    ElseIf m_CustomType = [单色] Then
       m_FrameColor = &H0
       m_FillColor = RGB(254, 152, 1)
       m_HookColor = &H0
    ElseIf m_CustomType = [矩形] Then
       m_FrameColor = RGB(163, 98, 9)
       m_FillColor = RGB(255, 238, 187)
       m_HookColor = RGB(254, 152, 1)
    Else
       m_FrameColor = &HBC5C2C
       m_FillColor = RGB(142, 188, 245)
       m_HookColor = RGB(44, 92, 188)
    End If
    Call SetColors
    Call UserControl_Resize
    PropertyChanged "CustomType"
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get Value() As State
Attribute Value.VB_Description = "返回/设置Check控件的值。"
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As State)
    m_Value = New_Value
       Call Redraw(0, True)
   
    PropertyChanged "Value"
End Property

'***********************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get ShowFocusRect() As Boolean
Attribute ShowFocusRect.VB_Description = "返回/设置Check控件的焦点是否可见。"
    ShowFocusRect = showFocusR
End Property

Public Property Let ShowFocusRect(ByVal New_ShowFocusRect As Boolean)
    showFocusR = New_ShowFocusRect
    Call Redraw(lastStat, True)
    PropertyChanged "ShowFocusRect"
End Property
'************************************************************************************************
'***********************************************************************************************
'为用户控件初始化属性
Private Sub UserControl_InitProperties()
    BackCol = GetSysColor(COLOR_BTNFACE)
    ForeCol = GetSysColor(COLOR_BTNTEXT)
    isEnabled = m_def_Enabled
    Set TextFont = Ambient.Font
    m_Caption = Extender.Name
    m_hWnd = m_def_hWnd
    m_HookColor = m_def_HookColor
    m_FrameColor = m_def_FrameColor
    m_FillColor = m_def_FillColor
    showFocusR = m_def_ShowFocusRect
    lastStat = 0

    m_Value = m_def_Value
    m_CheckType = m_def_CheckType
    m_CustomType = m_def_CustomType
    m_BackStyle = m_def_BackStyle
End Sub

'***********************************************************************************************
'***********************************************************************************************
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    BackCol = PropBag.ReadProperty("BackColor", GetSysColor(COLOR_BTNFACE))
    ForeCol = PropBag.ReadProperty("ForeColor", GetSysColor(COLOR_BTNTEXT))
    isEnabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
    Set TextFont = PropBag.ReadProperty("Font", Ambient.Font)
    m_Value = PropBag.ReadProperty("Value", m_def_Value)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    m_HookColor = PropBag.ReadProperty("HookColor", m_def_HookColor)
    m_FrameColor = PropBag.ReadProperty("FrameColor", m_def_FrameColor)
    m_FillColor = PropBag.ReadProperty("FillColor", m_def_FillColor)
    m_CheckType = PropBag.ReadProperty("CheckType", m_def_CheckType)
    m_CustomType = PropBag.ReadProperty("CustomType", m_def_CustomType)
    showFocusR = PropBag.ReadProperty("ShowFocusRect", m_def_ShowFocusRect)
    m_hWnd = PropBag.ReadProperty("hWnd", m_def_hWnd)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    UserControl.Enabled = isEnabled
    Set UserControl.Font = TextFont
    Call SetColors
    Call SetAccessKeys
    Call UserControl_Resize
    'Call Redraw(0, True)                                   '####(0,true)
End Sub
'***********************************************************************************************
'************************************************************************************************
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", BackCol, GetSysColor(COLOR_BTNFACE))
    Call PropBag.WriteProperty("ForeColor", ForeCol, GetSysColor(COLOR_BTNTEXT))
    Call PropBag.WriteProperty("Enabled", isEnabled, m_def_Enabled)
    Call PropBag.WriteProperty("Font", TextFont, Ambient.Font)

    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("HookColor", m_HookColor, m_def_HookColor)
    Call PropBag.WriteProperty("FrameColor", m_FrameColor, m_def_FrameColor)
    Call PropBag.WriteProperty("FillColor", m_FillColor, m_def_FillColor)
    Call PropBag.WriteProperty("ShowFocusRect", showFocusR, m_def_ShowFocusRect)
    Call PropBag.WriteProperty("hWnd", m_hWnd, m_def_hWnd)
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("CheckType", m_CheckType, m_def_CheckType)
    Call PropBag.WriteProperty("CustomType", m_CustomType, m_def_CustomType)
    Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
End Sub
'*****************************************************************************************************
'*************************************************************************************************
Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    Call UserControl_Click
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
'Debug.Print PropertyName
Call Redraw(lastStat, True)
End Sub

'******************************************************************************************************
Private Sub UserControl_DblClick()

   If LastButton = 1 Then
      Call UserControl_MouseDown(1, 1, 1, 1)
   End If

End Sub

Private Sub UserControl_GotFocus()
hasFocus = True
Call Redraw(lastStat, True)
End Sub
'*********************************************************************************************
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)

LastKeyDown = KeyCode
If KeyCode = 32 Then 'spacebar pressed
    Call UserControl_MouseDown(1, 1, 1, 1)
ElseIf (KeyCode = 39) Or (KeyCode = 40) Then 'right and down arrows
    SendKeys "{Tab}"
ElseIf (KeyCode = 37) Or (KeyCode = 38) Then 'left and up arrows
    SendKeys "+{Tab}"
End If
End Sub

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

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)

If (KeyCode = 32) And (LastKeyDown = 32) Then 'spacebar pressed
    Call UserControl_MouseUp(1, 1, 1, 1)
    LastButton = 1
    Call UserControl_Click
End If
End Sub

Private Sub UserControl_LostFocus()
hasFocus = False
Call Redraw(lastStat, True)
End Sub

Private Sub UserControl_Initialize()
LastButton = 1

Call SetColors
End Sub
Private Sub UserControl_Click()

      If (LastButton = 1) And (isEnabled = True) Then
         
          If m_Value = [Mixed] Then
             m_Value = [Unchecked]
          End If
          Call Redraw(0, True)
      End If
          
          UserControl.Refresh
          RaiseEvent Click
     
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
   LastButton = Button
   If Button <> 2 Then
      Call Redraw(2, True)                    '####Call Redraw(2, False)
      If m_Value = [Checked] Then
         m_Value = [Unchecked]
      ElseIf m_Value = [Unchecked] Then
         m_Value = [Checked]
    
      End If
   End If
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

     If Button <> 2 Then Call Redraw(0, True)                   '####Call Redraw(0, False)
        
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button < 2 Then
  
    Timer1.Enabled = True
    If X >= 0 And Y >= 0 And _
       X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
       '在按钮内部
        RaiseEvent MouseMove(Button, Shift, X, Y)
        If Button = vbLeftButton Then
            Call Redraw(2, True)                            'False)
            
        Else
             If disyellowrect = True Then
                Exit Sub
             Else
                disyellowrect = True
             End If
             Call Redraw(0, True)
        End If
    End If
  
End If

End Sub

Private Sub UserControl_Resize()
    Hei = UserControl.ScaleHeight
    Wid = UserControl.ScaleWidth
    rc.Left = 24: rc.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 3: rc.Right = UserControl.TextWidth(m_Caption) + 27: rc.Bottom = (Hei + UserControl.TextHeight(m_Caption)) \ 2 + 3
    
    rc2.Left = 25: rc2.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 2: rc2.Right = UserControl.TextWidth(m_Caption) + 28: rc2.Bottom = (Hei + UserControl.TextHeight(m_Caption)) \ 2 + 4
    rc3.Left = 23: rc3.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 1: rc3.Right = UserControl.TextWidth(m_Caption) + 26: rc3.Bottom = (Hei + UserControl.TextHeight(m_Caption)) \ 2 + 1
    
    DeleteObject rgnNorml
    Call MakeRegion
    SetWindowRgn UserControl.hwnd, rgnNorml, True
    
    Call Redraw(0, True)                                '####(0, True)
End Sub

Private Sub UserControl_Terminate()
    DeleteObject rgnNorml
End Sub

'按钮重画子程序

Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)
   Dim i As Long, stepXP1 As Single, XPface As Long
   Dim preFocusValue As Boolean
   Dim lens As Long
   Dim iunicode As Long
   Dim ii As Long
   Dim rval As Single, gval As Single, bval As Single
   Dim Red As Long, Green As Long, Blue As Long
   Dim pt As POINTAPI
   
If Hei = 0 Then Exit Sub
   UserControl.MaskPicture = Nothing
   UserControl.Picture = Nothing
   Call OleTranslateColor(BackCol, 0, BackCol)
   lastStat = curStat
   preFocusValue = hasFocus '保存焦点状态
If hasFocus = True Then hasFocus = ShowFocusRect

With UserControl
     .Cls
     DrawRectangle 0, 0, Wid, Hei, ccFace

If isEnabled = True Then
    SetTextColor .hdc, ccText
    If curStat = 0 Then
'#@#@#@#@#@# 在正常状态 #@#@#@#@#@#
        Select Case m_CheckType
            Case 1  'XP Windows
                
                 If disyellowrect Then              '= True
                      'If m_Value = False Then
                    DrawRectangle 2, Hei \ 2 - 8, 16, 16, &H733C00, True
                    DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                    
                    DrawRectangle 3, Hei \ 2 - 7, 14, 14, &H32AFFF, True
                    DrawRectangle 4, Hei \ 2 - 6, 12, 12, &H32AFFF, True
                    If m_Value = [Mixed] Then
                       DrawRectangle 5, Hei \ 2 - 5, 10, 10, RGB(31, 160, 33)                                   ', True
                    Else
                       DrawRectangle 5, Hei \ 2 - 5, 10, 10, RGB(230, 230, 230)
                         If m_Value = [Checked] Then
                            mSetPixelXp RGB(31, 160, 33)
   
                         End If
                    End If
                 Else
                      DrawRectangle 2, Hei \ 2 - 8, 16, 16, &H733C00, True
                      DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                      rval = 223
                      gval = 223
                      bval = 221
                      For i = 3 To 16
                          rval = rval + (255 - 223) / 8