wwradio.ctl

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

Dim Obj As Control
Dim lngContainerHandle As Long

    lngContainerHandle = UserControl.ContainerHwnd
    For Each Obj In Parent.Controls
        If TypeOf Obj Is wwradio Then
            If Obj.ContainerHwnd = lngContainerHandle And Obj.Name <> Ambient.DisplayName Then Obj.Value = False   'Obj.Group = lGroup And
        End If
    Next 'Obj
'    tVal = True
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_Value = PropBag.ReadProperty("Value", m_def_Value)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    m_hWnd = PropBag.ReadProperty("hWnd", m_def_hWnd)
    m_cPointColor = PropBag.ReadProperty("cPointColor", m_def_cPointColor)
    m_FrameColor = PropBag.ReadProperty("FrameColor", m_def_FrameColor)
    m_FillColor = PropBag.ReadProperty("FillColor", m_def_FillColor)
    m_RadioType = PropBag.ReadProperty("RadioType", m_def_RadioType)
    m_CustomRadioType = PropBag.ReadProperty("CustomRadioType", m_def_CustomRadioType)
    m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
    showFocusR = PropBag.ReadProperty("ShowFocusRect", m_def_ShowFocusRect)
    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", 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("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("cPointColor", m_cPointColor, m_def_cPointColor)
    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("BackStyle", m_BackStyle, m_def_BackStyle)
    
    Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
    Call PropBag.WriteProperty("RadioType", m_RadioType, m_def_RadioType)
    Call PropBag.WriteProperty("CustomRadioType", m_CustomRadioType, m_def_CustomRadioType)
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()
'Dim rd As Object
      If (LastButton = 1) And (isEnabled = True) Then
'          For Each rd In UserControl.Parent
'              'Debug.Print UserControl.Parent
'              If TypeOf rd Is wwradio Then
'                 rd.Value = False
'              End If
'          Next ' rd
          UnCheckOther
          Value = True
      
          Call Redraw(0, True)                                '####(0, True) 'be sure that the normal status is drawn
      End If
          
          UserControl.Refresh
          RaiseEvent Click
     
End Sub


Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   UnCheckOther
   Value = True
   LastButton = Button
   If Button <> 2 Then
      Call Redraw(2, True)                    '####Call Redraw(2, False)
   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 = 20: rc.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 3: rc.Right = UserControl.TextWidth(m_Caption) + 23: rc.Bottom = (Hei + UserControl.TextHeight(m_Caption)) \ 2 + 3
    rc2.Left = 21: rc2.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 2: rc2.Right = UserControl.TextWidth(m_Caption) + 24: rc2.Bottom = (Hei + UserControl.TextHeight(m_Caption)) \ 2 + 4
    rc3.Left = 19: rc3.Top = (Hei - UserControl.TextHeight(m_Caption)) \ 2 - 1: rc3.Right = UserControl.TextWidth(m_Caption) + 22: 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(BackC, 0, BackC)
   lastStat = curStat
   preFocusValue = hasFocus '保存焦点状态
If hasFocus Then hasFocus = ShowFocusRect

With UserControl
     .Cls
     DrawRectangle 0, 0, Wid, Hei, ccFace
     lens = Len(m_Caption)
    

If isEnabled Then
    SetTextColor .hdc, ccText
    If curStat = 0 Then
'#@#@#@#@#@# 在正常状态 #@#@#@#@#@#
        SetTextColor .hdc, ccText
        DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
        Select Case m_RadioType
            Case 1  'XP Windows
                 DrawXPFrame
                 If disyellowrect = True Then
                    .FillStyle = 1
                    UserControl.Circle (7, Hei \ 2), 5, &H48BEF9
                    UserControl.Circle (7, Hei \ 2), 4, &H48BEF9
                    For ii = 0 To 5 Step 5
                       mSetPixel 2 + ii, Hei \ 2 - ii, &H8CD5F3
                      mSetPixel 12 - ii, Hei \ 2 + ii, &H8CD5F3
                    Next

                    For ii = 0 To 2 Step 2
                       mSetPixel 6 - ii, Hei \ 2 - 3 + ii, &H97D7F6
                       mSetPixel 8 + ii, Hei \ 2 - 3 + ii, &H97D7F6
                    Next

                    For ii = 0 To 2 Step 2
                       mSetPixel 4 + ii, Hei \ 2 + 1 + ii, &H97D7F6
                      mSetPixel 10 - ii, Hei \ 2 + 1 + ii, &H97D7F6
                    Next
                    
                 End If
                 If m_Value Then
                    DrawXPPoint
                 End If
            Case 2   'Custom
                 Select Case m_CustomRadioType
                        Case 1                    ' 渐变
                             If disyellowrect Then
                                DrawUpFrame ShiftColor(m_FrameColor, &H50)
                                DrawDownFrame ShiftColor(m_FrameColor, &H30)
                             Else
                                DrawDownFrame m_FrameColor
                                DrawUpFrame m_FrameColor
                             End If
                             DrawChangLine m_FillColor, 12, 8, 2, 1
                             If m_Value Then
                                DrawChangLine m_FillColor, 12, 8, 2, -1
                                DrawCenterPoint m_cPointColor
                                DrawCenterUpShadow m_FrameColor
                                DrawCenterDownShadow &HFFFFFF
                             End If
                        'Case 2                    ' 单色

                         'Case 3

                 End Select
            'Case 3    'Force Standard

            'Case 4

                 
        End Select
        If hasFocus And Len(m_Caption) <> 0 Then DrawFocusR
    ElseIf curStat = 2 Then
'#@#@#@#@#@# 按钮按下 #@#@#@#@#@#
        Select Case m_RadioType
            Case 1
                 DrawXPFrame
                 SetTextColor .hdc, ccText
                 DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                 DrawLine 3, Hei \ 2 - 2, 6, Hei \ 2 - 5, &HAFB7B6
                 DrawLine 2, Hei \ 2, 8, Hei \ 2 - 6, &HAFB7B6
                 DrawLine 3, Hei \ 2, 8, Hei \ 2 - 5, &HAFB7B6
                 
                 DrawLine 3, Hei \ 2 + 1, 9, Hei \ 2 - 5, &HBDC6C9
                 DrawLine 3, Hei \ 2 + 2, 10, Hei \ 2 - 5, &HBFCBCD
                 DrawLine 4, Hei \ 2 + 2, 10, Hei \ 2 - 4, &HC5D1D1
                 DrawLine 4, Hei \ 2 + 3, 11, Hei \ 2 - 4, &HC8D4D4
                 DrawLine 5, Hei \ 2 + 3, 11, Hei \ 2 - 3, &HC7D6D8
                 
                 DrawLine 5, Hei \ 2 + 4, 12, Hei \ 2 - 3, &HD0DDDF
                 DrawLine 6, Hei \ 2 + 4, 12, Hei \ 2 - 2, &HD2E1E3
                 DrawLine 7, Hei \ 2 + 4, 12, Hei \ 2 - 1, &HD1E6E4
                 DrawLine 7, Hei \ 2 + 5, 13, Hei \ 2 - 1, &HD7E3E7
                 DrawLine 9, Hei \ 2 + 4, 12, Hei \ 2 + 1, &HDBEAED
                    
                 If m_Value = True Then
                    DrawXPPoint
                 End If
            Case 2 'custom
                 SetTextColor .hdc, ccText
                 DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
                 Select Case m_CustomRadioType
                        Case 1
                             DrawUpFrame ShiftColor(m_FrameColor, -&H50)
                             DrawDownFrame ShiftColor(m_FrameColor, -&H30)
                             ccrgb = ShiftColor(m_FillColor, -&H30)
                             DrawChangLine ccrgb, 12, 8, 2, 1
                             If m_Value = True Then
                                DrawChangLine ccrgb, 12, 8, 2, -1
                                DrawCenterPoint ShiftColor(m_cPointColor, -&H30)
                                DrawCenterUpShadow ShiftColor(m_FrameColor, -&H30)
                                DrawCenterDownShadow ShiftColor(&HFFFFFF, -&H30)
                             End If
                        'Case 2

                        'Case 3

                 End Select
            'Case 3 'force standard

            'Case 4

        End Select
        If hasFocus = True And Len(m_Caption) <> 0 Then DrawFocusR
    End If
Else
'#~#~#~#~#~# DISABLED STATUS #~#~#~#~#~#

    SetTextColor UserControl.hdc, &HFFFFFF
    DrawText .hdc, m_Caption, -1, rc2, DT_CENTERABS
    SetTextColor UserControl.hdc, ccShadow
    DrawText .hdc, m_Caption, -1, rc, DT_CENTERABS
    Select Case m_RadioType
           Case 1
                 DrawSub ccShadow
                 UserControl.FillStyle = 0
                 UserControl.FillColor = &HF3F1F0
                 UserControl.Circle (7, Hei \ 2), 5, &HC1CBCB
                 
                 If m_Value Then
                    DrawRectangle 5, Hei \ 2 - 1, 5, 3, &HCED2D3, True
                    DrawRectangle 6, Hei \ 2 - 2, 3, 5, &HCED2D3, True
                    mSetPixel 6, Hei \ 2 - 1, &HB2BEBE
                    For i = 0 To 2
                        mSetPixel 5 + i, Hei \ 2, &HB2BEBE
                    Next 'i
                    mSetPixel 6, Hei \ 2 + 1, &HB2BEBE
                    For i = 0 To 1
                        mSetPixel 7, Hei \ 2 - 2 + i, &HB2BEBE
                    Next
                    For i = 3 To 4
                        mSetPixel 7, Hei \ 2 - 2 + i, &HB2BEBE
                    Next
                    For i = 0 To 2
                        mSetPixel 8, Hei \ 2 - 1 + i, &HB2BEBE
                    Next
                    
                    mSetPixel 9, Hei \ 2, &HB2BEBE
                    
                 End If
           Case 2
                Select Case m_CustomRadioType
                        Case 1
                             DrawUpFrame ccShadow
                             DrawDownFrame ccShadow
                             DrawChangLine ccLight, 6, 6, 6, 1
                             If m_Value = True Then
                                DrawChangLine ccLight, 6, 6, 6, -1