wwradio.ctl

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

                                DrawCenterPoint ShiftColor(ccDarkShadow, &H30)
                                DrawCenterUpShadow ShiftColor(ccShadow, &H20)
                                DrawCenterDownShadow ShiftColor(ccShadow, &H20)
                             End If


                 End Select


    End Select
End If
End With
'restore focus value
hasFocus = preFocusValue

    If m_BackStyle = [Transparent] Then
        'transparent
        With UserControl
            .BackStyle = 0
            .MaskColor = BackC
            Set MaskPicture = .Image
        End With
    Else
        UserControl.BackStyle = 1
    End If
    Call UserControl.Refresh
End Sub

Private Sub DrawRectangle(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long, Optional OnlyBorder As Boolean = False)

Dim bRect As RECT
Dim hBrush As Long
Dim ret As Long

bRect.Left = X
bRect.Top = Y
bRect.Right = X + Width
bRect.Bottom = Y + Height

hBrush = CreateSolidBrush(Color)

If OnlyBorder = False Then
    ret = FillRect(UserControl.hdc, bRect, hBrush)
Else
    ret = FrameRect(UserControl.hdc, bRect, hBrush)
End If

ret = DeleteObject(hBrush)
End Sub
Private Sub DrawSub(lColor As Long)
                 DrawLine 1, Hei \ 2 - 3, 1, Hei \ 2 + 4, lColor       '&HB5BEC1
                 DrawLine 13, Hei \ 2 - 3, 13, Hei \ 2 + 4, lColor

                 DrawLine 4, Hei \ 2 - 6, 11, Hei \ 2 - 6, lColor
                 DrawLine 4, Hei \ 2 + 6, 11, Hei \ 2 + 6, lColor

                 DrawLine 2, Hei \ 2 - 3, 2, Hei \ 2 - 5, lColor
                 DrawLine 2, Hei \ 2 - 5, 5, Hei \ 2 - 5, lColor

                 DrawLine 12, Hei \ 2 + 3, 12, Hei \ 2 + 5, lColor
                 DrawLine 12, Hei \ 2 + 5, 9, Hei \ 2 + 5, lColor

                 DrawLine 10, Hei \ 2 - 5, 12, Hei \ 2 - 5, lColor
                 DrawLine 12, Hei \ 2 - 5, 12, Hei \ 2 - 2, lColor

                 DrawLine 2, Hei \ 2 + 3, 2, Hei \ 2 + 5, lColor
                 DrawLine 2, Hei \ 2 + 5, 5, Hei \ 2 + 5, lColor
End Sub
Private Sub DrawXPFrame()

                 
                 DrawSub &H733C00
                 UserControl.FillStyle = 0
                 UserControl.FillColor = &HF3F1F0
                 UserControl.Circle (7, Hei \ 2), 5, &HC0B6A5
                 
                 DrawSubPoint 2, 2, &HA3815D
                 DrawSubPoint 3, 4, &HA3815D
                 DrawSubPoint 5, 5, &HA3815D

End Sub
Private Sub DrawSubPoint(xPos As Long, yPos As Long, lColor As Long)

mSetPixel xPos, Hei \ 2 + yPos, lColor
mSetPixel xPos, Hei \ 2 - yPos, lColor
mSetPixel 14 - xPos, Hei \ 2 + yPos, lColor
mSetPixel 14 - xPos, Hei \ 2 - yPos, lColor
End Sub
Private Sub DrawXPPoint()
Dim i As Long
    DrawRectangle 5, Hei \ 2 - 1, 5, 3, &H98C898, True
    DrawRectangle 6, Hei \ 2 - 2, 3, 5, &H98C898, True
    mSetPixel 6, Hei \ 2 - 1, &H50D556
    For i = 0 To 2
        mSetPixel 5 + i, Hei \ 2, &H36BA38
    Next i
    mSetPixel 7, Hei \ 2 - 2, &H36BA38
    mSetPixel 7, Hei \ 2 - 1, &H36BA38
                    
    mSetPixel 6, Hei \ 2 + 1, &H24A92B
    mSetPixel 7, Hei \ 2 + 1, &H2AA221
    mSetPixel 8, Hei \ 2 + 1, &H249424
    mSetPixel 8, Hei \ 2, &H24A92B
    mSetPixel 8, Hei \ 2 - 1, &H24A92B
    mSetPixel 9, Hei \ 2, &H249424
    mSetPixel 7, Hei \ 2 + 2, &H249424

End Sub
Private Sub DrawUpFrame(ByVal Color As Long)          '画上半圆  标准
    DrawLine 2, Hei \ 2 + 2, 2, Hei \ 2 + 4, Color
    DrawLine 1, Hei \ 2 - 2, 1, Hei \ 2 + 2, Color
    DrawLine 2, Hei \ 2 - 4, 2, Hei \ 2 - 2, Color
    DrawLine 3, Hei \ 2 - 5, 5, Hei \ 2 - 5, Color
    DrawLine 5, Hei \ 2 - 6, 9, Hei \ 2 - 6, Color
    DrawLine 9, Hei \ 2 - 5, 11, Hei \ 2 - 5, Color
End Sub
Private Sub DrawDownFrame(ByVal Color As Long)          '画下半圆  标准
    DrawLine 3, Hei \ 2 + 4, 5, Hei \ 2 + 4, Color
    DrawLine 5, Hei \ 2 + 5, 9, Hei \ 2 + 5, Color
    DrawLine 9, Hei \ 2 + 4, 11, Hei \ 2 + 4, Color
    DrawLine 11, Hei \ 2 + 2, 11, Hei \ 2 + 4, Color
    DrawLine 12, Hei \ 2 - 2, 12, Hei \ 2 + 2, Color
    DrawLine 11, Hei \ 2 - 4, 11, Hei \ 2 - 2, Color
End Sub
Private Sub DrawCenterPoint(ByVal Color As Long)          '画中心点

    DrawLine 6, Hei \ 2 - 2, 8, Hei \ 2 - 2, Color
    DrawLine 5, Hei \ 2 - 1, 9, Hei \ 2 - 1, Color
    DrawLine 5, Hei \ 2, 9, Hei \ 2, Color
    DrawLine 6, Hei \ 2 + 1, 8, Hei \ 2 + 1, Color
    
End Sub
Private Sub DrawCenterUpShadow(ByVal Color As Long)          '画中心点阴影上半部
    DrawLine 4, Hei \ 2 - 1, 4, Hei \ 2 + 1, Color
    mSetPixel 5, Hei \ 2 - 2, Color
    DrawLine 6, Hei \ 2 - 3, 8, Hei \ 2 - 3, Color
    mSetPixel 8, Hei \ 2 - 2, Color
End Sub
Private Sub DrawCenterDownShadow(ByVal Color As Long)          '画中心点阴影下半部
    DrawLine 9, Hei \ 2 - 1, 9, Hei \ 2 + 1, Color
    mSetPixel 8, Hei \ 2 + 1, Color
    DrawLine 6, Hei \ 2 + 2, 8, Hei \ 2 + 2, Color
    mSetPixel 5, Hei \ 2 + 1, Color
End Sub


Private Sub DrawChangLine(ByVal Color As Long, ByVal rc As Long, ByVal Gc As Long, ByVal Bc As Long, ByVal Decinc As Long)
Dim n As Long
     If Decinc = 1 Then
        n = 0
     Else
        n = 1
     End If
        DrawLine 5, Hei \ 2 + Decinc * (n + 4), 9, Hei \ 2 + Decinc * (n + 4), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 3, Hei \ 2 + Decinc * (n + 3), 11, Hei \ 2 + Decinc * (n + 3), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 3, Hei \ 2 + Decinc * (n + 2), 11, Hei \ 2 + Decinc * (n + 2), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 2, Hei \ 2 + Decinc * (n + 1), 12, Hei \ 2 + Decinc * (n + 1), Color '画渐变线
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 2, Hei \ 2 + Decinc * n, 12, Hei \ 2 + Decinc * n, Color
                 
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 2, Hei \ 2 - Decinc * (1 - n), 12, Hei \ 2 - Decinc * (1 - n), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 2, Hei \ 2 - Decinc * (2 - n), 12, Hei \ 2 - Decinc * (2 - n), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 3, Hei \ 2 - Decinc * (3 - n), 11, Hei \ 2 - Decinc * (3 - n), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 3, Hei \ 2 - Decinc * (4 - n), 11, Hei \ 2 - Decinc * (4 - n), Color
        Color = ShiftColorCustom(Color, rc, Gc, Bc, RGB(250, 255, 255))
        DrawLine 5, Hei \ 2 - Decinc * (5 - n), 9, Hei \ 2 - Decinc * (5 - n), Color
                 
End Sub
Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
Dim pt As POINTAPI

UserControl.ForeColor = Color
MoveToEx UserControl.hdc, X1, Y1, pt
LineTo UserControl.hdc, X2, Y2

End Sub

Private Sub mSetPixel(ByVal X As Long, ByVal Y As Long, ByVal Color As Long)
    Call SetPixelV(UserControl.hdc, X, Y, Color)
End Sub


Private Sub mSetPixelTexture(ByVal xBasePoint As Long)      '画混合色
Dim cdc As Long
Dim i As Long
Dim Red As Long, Blue As Long, Green As Long
    cdc = ShiftColorCustom(m_FrameColor, 30, 55, 75, RGB(240, 240, 240))
    Blue = ((cdc \ &H10000) Mod &H100)
    Green = ((cdc \ &H100) Mod &H100)
    Red = (cdc And &HFF)
    mSetPixel xBasePoint, Hei \ 2, RGB(255, 255, 255)
    For i = 1 To 4
        DrawRectangle xBasePoint - i, Hei \ 2 - i, 2 * i + 1, 2 * i + 1, ShiftColorCustom(cdc, (255 - Red) * (5 - i) / 5, (255 - Green) * (5 - i) / 5, (255 - Blue) * (5 - i) / 5, RGB(255, 255, 255)), True
    Next i
End Sub
'**************************************************************************
Private Sub DrawFocusR()                                           '画焦点框
    SetTextColor UserControl.hdc, ccText
    DrawFocusRect UserControl.hdc, rc3                                      'rc3
End Sub
Private Sub SetColors()

'If BackC = &H80000001 Then
'   BackC = RGB(58, 110, 165)
'ElseIf BackC = &H80000004 Or BackC = &H80000000 Or BackC = &H8000000A Or BackC = &H8000000B Or BackC = &H8000000F Or BackC = &H80000013 Or BackC = &H80000016 Then
'   BackC = RGB(212, 208, 200)
'End If
If m_RadioType = [自定义] Then                                               '
    ccFace = BackC
    ccText = ForeC
    
    ccShadow = ShiftColor(ccFace, -&H40)
    ccLight = ShiftColor(ccFace, &H1F)
    ccHighLight = ShiftColor(ccFace, &H2F)
    ccDarkShadow = ShiftColor(ccFace, -&HC0)
ElseIf m_RadioType = [标准] Then
    ccShadow = GetSysColor(COLOR_BTNSHADOW)
    ccLight = GetSysColor(COLOR_BTNLIGHT)
    ccDarkShadow = GetSysColor(COLOR_BTNDKSHADOW)
    ccHighLight = GetSysColor(COLOR_BTNHIGHLIGHT)
    ccFace = BackC
    ccText = ForeC       'GetSysColor(COLOR_BTNTEXT)
ElseIf m_RadioType = [Xp 风格] Then
    ccFace = BackC
   
    ccText = ForeC
Else
'if MyColorType is 1 or has not been set then use windows colors
    ccFace = GetSysColor(COLOR_BTNFACE)
    ccShadow = GetSysColor(COLOR_BTNSHADOW)
    ccLight = GetSysColor(COLOR_BTNLIGHT)
    ccDarkShadow = GetSysColor(COLOR_BTNDKSHADOW)
    ccHighLight = GetSysColor(COLOR_BTNHIGHLIGHT)
    ccText = ForeC       'GetSysColor(COLOR_BTNTEXT)
End If
End Sub

Private Sub MakeRegion()
Dim rgn1 As Long, rgn2 As Long
    
        DeleteObject rgnNorml
        rgnNorml = CreateRectRgn(0, 0, Wid, Hei)
        rgn2 = CreateRectRgn(0, 0, 0, 0)
    
        rgn1 = CreateRectRgn(0, 0, 1, 1)
        CombineRgn rgn2, rgnNorml, rgn1, RGN_DIFF
        DeleteObject rgn1
        rgn1 = CreateRectRgn(0, Hei, 1, Hei - 1)
        CombineRgn rgnNorml, rgn2, rgn1, RGN_DIFF
        DeleteObject rgn1
        rgn1 = CreateRectRgn(Wid, 0, Wid - 1, 1)
        CombineRgn rgn2, rgnNorml, rgn1, RGN_DIFF
        DeleteObject rgn1
        rgn1 = CreateRectRgn(Wid, Hei, Wid - 1, Hei - 1)
        CombineRgn rgnNorml, rgn2, rgn1, RGN_DIFF
        DeleteObject rgn1


DeleteObject rgn2
End Sub

Private Sub SetAccessKeys()
'设置访问键

Dim ampersandPos As Long

If Len(m_Caption) > 1 Then
    ampersandPos = InStr(1, m_Caption, "&", vbBinaryCompare)
    If (ampersandPos < Len(m_Caption)) And (ampersandPos > 0) Then
        If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then 'if text is something like && then no access key should be assigned, so continue searching
            UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
        Else 'do only a second pass to find another ampersand character
            ampersandPos = InStr(ampersandPos + 2, m_Caption, "&", vbBinaryCompare)
            If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then
                UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
            Else
                UserControl.AccessKeys = ""
            End If
        End If
    Else
        UserControl.AccessKeys = ""
    End If
Else
    UserControl.AccessKeys = ""
End If
End Sub

Private Function ShiftColor(ByVal Color As Long, ByVal Value As Long) As Long

Dim Red As Long, Blue As Long, Green As Long
Blue = ((Color \ &H10000) Mod &H100) + Value
Green = ((Color \ &H100) Mod &H100) + Value
Red = (Color And &HFF) + Value
    If Red < 0 Then
        Red = 0
    ElseIf Red > 255 Then
        Red = 255
    End If
    If Green < 0 Then
        Green = 0
    ElseIf Green > 255 Then
        Green = 255
    End If
    If Blue < 0 Then
        Blue = 0
    ElseIf Blue > 255 Then
        Blue = 255
    End If

ShiftColor = RGB(Red, Green, Blue)
End Function

Private Function ShiftColorCustom(ByVal Color As Long, ByVal Rcl As Long, ByVal Gcl As Long, ByVal Bcl As Long, ByVal Color1 As Long) As Long
Dim Red As Long, Blue As Long, Green As Long
Dim Red1 As Long, Blue1 As Long, Green1 As Long

Blue = ((Color \ &H10000) Mod &H100) + Bcl
Green = ((Color \ &H100) Mod &H100) + Gcl
Red = (Color And &HFF) + Rcl
Blue1 = ((Color1 \ &H10000) Mod &H100)
Green1 = ((Color1 \ &H100) Mod &H100)
Red1 = (Color1 And &HFF)
    If Red < 0 Then
        Red = 0
    ElseIf Red > Red1 Then
        Red = Red1
    End If
    If Green < 0 Then
        Green = 0
    ElseIf Green > Green1 Then
        Green = Green1
    End If
    If Blue < 0 Then
        Blue = 0
    ElseIf Blue > Blue1 Then
        Blue = Blue1
    End If

ShiftColorCustom = RGB(Red, Green, Blue)
End Function

'**************************************************************************
'     timer事件处理鼠标移出
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Private Sub Timer1_Timer()
    Dim pnt As POINTAPI
    GetCursorPos pnt
    ScreenToClient UserControl.hwnd, pnt

    If pnt.X < UserControl.ScaleLeft Or _
       pnt.Y < UserControl.ScaleTop Or _
       pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
       pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
       
        Timer1.Enabled = False
        RaiseEvent MouseOut
        disyellowrect = False
        Call Redraw(0, True)                                          'True
    End If
End Sub