wwbutton.ctl

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

With TextFont
      .Bold = New_Font.Bold
      .Italic = New_Font.Italic
      .Name = New_Font.Name
      .Size = New_Font.Size
End With
    Set TextFont = New_Font
    Set UserControl.Font = TextFont
    Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "Font"
End Property

'*********************************************************************************
Private Sub UserControl_Initialize()
LastButton = 1
rc2.Left = 2: rc2.Top = 2
Call SetColors
'Set TextFont = New StdFont
'Set UserControl.Font = TextFont
End Sub
'**********************************************************************************
'************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property
'
Public Property Let hwnd(ByVal New_hWnd As Long)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_hWnd = New_hWnd
    PropertyChanged "hWnd"
End Property
''***********************************************************************************

''**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=21,0,0,0
Public Property Get ButtonType() As ButtonTypes
    ButtonType = MyButtonType
End Property

Public Property Let ButtonType(ByVal New_ButtonType As ButtonTypes)
    MyButtonType = New_ButtonType
    Call SetColors

    Call UserControl_Resize
    'Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "ButtonType"
End Property

'**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=13,0,0,0
Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    Call SetAccessKeys
    Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "Caption"
End Property
'******************************************************************************************
'

''*********************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=22,0,0,0
Public Property Get ColorScheme() As ColorTypes
    ColorScheme = MyColorType
End Property

Public Property Let ColorScheme(ByVal New_ColorScheme As ColorTypes)
    MyColorType = New_ColorScheme
    Call SetColors
    Call Redraw(lastStat, True)                                        '####(0, True)
    PropertyChanged "ColorScheme"
End Property


Public Property Get XpType() As XpTypes
    XpType = MyXpType
End Property

Public Property Let XpType(ByVal New_XpType As XpTypes)
    MyXpType = New_XpType
    'Call SetColors
    Call Redraw(lastStat, True)                                                '####Call Redraw(0, True)
    PropertyChanged "XpType"
End Property
'*********************************************************************************************


'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get rectcolor() As OLE_COLOR
    rectcolor = m_rectcolor
End Property

Public Property Let rectcolor(ByVal New_rectcolor As OLE_COLOR)
    m_rectcolor = New_rectcolor
    PropertyChanged "rectcolor"
End Property
'***********************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get ShowFocusRect() As Boolean
    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()

    BackC = GetSysColor(COLOR_BTNFACE)
    ForeC = GetSysColor(COLOR_BTNTEXT)
    isEnabled = m_def_Enabled
   ' Set TextFont = Ambient.Font
    Set TextFont = UserControl.Font
    m_hWnd = m_def_hWnd
    MyButtonType = m_def_ButtonType
    m_Caption = Extender.Name                          ' m_def_Caption
    MyColorType = m_def_ColorScheme
    MyXpType = [银色风格]
    showFocusR = m_def_ShowFocusRect
    m_rectcolor = m_def_rectcolor
    lastStat = 0
    
    m_Percent = m_def_Percent
    m_MidColor = m_def_MidColor
    m_EndColor = m_def_EndColor
    m_MouseMoveMidColor = m_def_MouseMoveMidColor
    m_MouseMoveEndColor = m_def_MouseMoveEndColor
    m_MouseDownMidColor = m_def_MouseDownMidColor
    m_MouseDownEndColor = m_def_MouseDownEndColor

End Sub

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

    BackC = PropBag.ReadProperty("BackColor", GetSysColor(COLOR_BTNFACE))
    ForeC = PropBag.ReadProperty("ForeColor", GetSysColor(COLOR_BTNTEXT))
    isEnabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
    Set TextFont = PropBag.ReadProperty("Font", Ambient.Font)
    m_hWnd = PropBag.ReadProperty("hWnd", m_def_hWnd)
    'm_Value = PropBag.ReadProperty("Value", m_def_Value)
    MyButtonType = PropBag.ReadProperty("ButtonType", m_def_ButtonType)
    MyXpType = PropBag.ReadProperty("XpType", m_def_XpType)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    MyColorType = PropBag.ReadProperty("ColorScheme", m_def_ColorScheme)
    showFocusR = PropBag.ReadProperty("ShowFocusRect", m_def_ShowFocusRect)
    UserControl.Enabled = isEnabled
    Set UserControl.Font = TextFont
    Call SetColors
    Call SetAccessKeys
   
    m_rectcolor = PropBag.ReadProperty("rectcolor", m_def_rectcolor)
    m_Percent = PropBag.ReadProperty("Percent", m_def_Percent)
    m_MidColor = PropBag.ReadProperty("MidColor", m_def_MidColor)
    m_EndColor = PropBag.ReadProperty("EndColor", m_def_EndColor)
    m_MouseMoveEndColor = PropBag.ReadProperty("MouseMoveEndColor", m_def_MouseMoveEndColor)
    m_MouseMoveMidColor = PropBag.ReadProperty("MouseMoveMidColor", m_def_MouseMoveMidColor)
    m_MouseDownEndColor = PropBag.ReadProperty("MouseDownEndColor", m_def_MouseDownEndColor)
    m_MouseDownMidColor = PropBag.ReadProperty("MouseDownMidColor", m_def_MouseDownMidColor)

       lastStat = 0

    Call Redraw(lastStat, True)                                   '####(0,true)
    
End Sub
'***********************************************************************************************
'************************************************************************************************
'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", BackC, GetSysColor(COLOR_BTNFACE))
    Call PropBag.WriteProperty("ForeColor", ForeC, GetSysColor(COLOR_BTNTEXT))
    Call PropBag.WriteProperty("Enabled", isEnabled, m_def_Enabled)
    Call PropBag.WriteProperty("Font", TextFont, Ambient.Font)
    Call PropBag.WriteProperty("hWnd", m_hWnd, m_def_hWnd)
    Call PropBag.WriteProperty("ButtonType", MyButtonType, m_def_ButtonType)
    Call PropBag.WriteProperty("XpType", MyXpType, m_def_XpType)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("ColorScheme", MyColorType, m_def_ColorScheme)
    Call PropBag.WriteProperty("ShowFocusRect", showFocusR, m_def_ShowFocusRect)

    Call PropBag.WriteProperty("rectcolor", m_rectcolor, m_def_rectcolor)
    Call PropBag.WriteProperty("Percent", m_Percent, m_def_Percent)
    Call PropBag.WriteProperty("MidColor", m_MidColor, m_def_MidColor)
    Call PropBag.WriteProperty("EndColor", m_EndColor, m_def_EndColor)
    Call PropBag.WriteProperty("MouseMoveMidColor", m_MouseMoveMidColor, m_def_MouseMoveMidColor)
    Call PropBag.WriteProperty("MouseMoveEndColor", m_MouseMoveEndColor, m_def_MouseMoveEndColor)
    Call PropBag.WriteProperty("MouseDownMidColor", m_MouseDownMidColor, m_def_MouseDownMidColor)
    Call PropBag.WriteProperty("MouseDownEndColor", m_MouseDownEndColor, m_def_MouseDownEndColor)

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 isEnabled = True Then
   If LastButton = 1 Then
      Call UserControl_MouseDown(1, 1, 1, 1)
   End If
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)
If isEnabled = True Then
   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 If
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
If isEnabled = True Then
   RaiseEvent KeyPress(KeyAscii)
End If
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
If isEnabled = True Then
   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 If
End Sub

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


Private Sub UserControl_Click()
   If isEnabled = True Then
      If (LastButton = 1) Then
          lastStat = 0
          'Call Redraw(lastStat, True)                                '####(0, True) 'be sure that the normal status is drawn

      End If
          Call Redraw(lastStat, True)
          UserControl.Refresh
          RaiseEvent Click
    End If
End Sub


Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
If isEnabled = True Then

   'Else
   
      LastButton = Button
      If Button <> 2 Then lastStat = 2                    '####Call Redraw(2, False)
   'End If
   Call Redraw(lastStat, True)
   RaiseEvent MouseDown(Button, Shift, X, y)
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
If isEnabled = True Then

     If Button <> 2 Then lastStat = 0                    '####Call Redraw(0, False)

  Call Redraw(lastStat, True)
  RaiseEvent MouseUp(Button, Shift, X, y)
End If
End Sub