wwradio.ctl

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

VERSION 5.00
Begin VB.UserControl wwradio 
   AutoRedraw      =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   DefaultCancel   =   -1  'True
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "wwradio.ctx":0000
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   10
      Left            =   435
      Top             =   1020
   End
End
Attribute VB_Name = "wwradio"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
'Private Const DT_LEFT = &H0
Private Const DT_CENTERABS = &H65                    'CENTERABS= &H65
Const DT_WORDBREAK = &H10
Const DT_CENTER = &H1
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_BTNTEXT = 18
Private Const COLOR_BTNHIGHLIGHT = 20
Private Const COLOR_BTNDKSHADOW = 21
Private Const COLOR_BTNLIGHT = 22
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Const RGN_DIFF = 4

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long


Public Enum CustomRadioTypes
    [渐变] = 1
    [单色] = 2
    [翠绿] = 3
End Enum
Public Enum RadioTypes
    [Xp 风格] = 1
    [自定义] = 2
    [标准] = 3
    [传统] = 4
End Enum
Public Enum BackStyleConstants
    Transparent = 0
    Opaque = 1
End Enum
'属性变量:
Private Hei As Long  'wwradio的高度
Private Wid As Long  'wwradio的宽度
'Dim allcount As Integer                       'caption字节总数
Private BackC As Long 'back color
Private ForeC As Long 'fore color

Private m_Caption As String     'current caption  变量
Private TextFont As StdFont 'current font

Private rc As RECT, rc2 As RECT, rc3 As RECT
Private rgnNorml As Long                           '正常区域句柄

Private LastButton As Byte, LastKeyDown As Byte         '上一次按钮状态和上一次键盘按下状态
Private isEnabled As Boolean
Private hasFocus As Boolean                         '焦点标志
Private disyellowrect As Boolean                         '鼠标移入时显示黄色圆角矩形标志
Private ccFace As Long, ccLight As Long, ccHighLight As Long, ccShadow As Long, ccDarkShadow As Long, ccText As Long

Private lastStat As Byte, Te As String '        保存状态，消除不必要的重画
Private m_cPointColor As Long
Private m_FrameColor As Long
Private m_FillColor As Long
Dim m_Value As Boolean
Dim m_hWnd As Long
Dim showFocusR As Boolean
Dim m_RadioType As RadioTypes
Dim m_CustomRadioType As CustomRadioTypes
Private m_BackStyle As BackStyleConstants

Dim ccrgb As Long
Dim ccrgb1 As Long
'缺省属性值:
Const m_def_Value = False
Const m_def_Enabled = True
Const m_def_hWnd = 0
Const m_def_Caption = "wwradio"
Const m_def_cPointColor = &H53FF                             ' &H58C3FA
Const m_def_FrameColor = &HBC5C2C
Const m_def_FillColor = &HF5BC8E
Const m_def_RadioType = [Xp 风格]
Const m_def_CustomRadioType = [渐变]
Const m_def_ShowFocusRect = True
Const m_def_BackStyle = Opaque
'事件声明:
Event Click()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseOut()
'********************************************************************************
Public Property Get BackStyle() As BackStyleConstants
BackStyle = m_BackStyle
End Property
Public Property Let BackStyle(BackStyle As BackStyleConstants)
m_BackStyle = BackStyle
UserControl.BackStyle = BackStyle
'bNotOk = False
' UserControl_Paint
Call Redraw(lastStat, True)
PropertyChanged "BackStyle"
End Property

'********************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置Radio控件的背景色。"
    BackColor = BackC
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    BackC = New_BackColor
    Call SetColors
    Call Redraw(lastStat, True)
    PropertyChanged "BackColor"
End Property

'***********************************************************************************
'********************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=10,0,0,0
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "返回/设置Radio控件的前景色。"
    ForeColor = ForeC
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    ForeC = New_ForeColor
    Call SetColors
    Call Redraw(lastStat, True)
    PropertyChanged "ForeColor"
End Property

'**********************************************************************************
'**************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "返回/设置Radio控件的Enabled属性。"
    Enabled = isEnabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    isEnabled = New_Enabled
    Call Redraw(0, True)                                           '####(0, True)
    UserControl.Enabled = isEnabled
    PropertyChanged "Enabled"
End Property
'********************************************************************************

'********************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=6,0,0,0
Public Property Get Font() As Font
Attribute Font.VB_Description = "返回/设置Radio控件的字体。"
    Set Font = TextFont
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set TextFont = New_Font
    Set UserControl.Font = TextFont
    Call Redraw(lastStat, True)                                         '####(0, True)
    PropertyChanged "Font"
End Property

'**********************************************************************************
'************************************************************************************
'注意！不要删除或修改下列被注释的行！
'MemberInfo=8,0,0,0
Public Property Get hwnd() As Long
Attribute hwnd.VB_Description = "返回Radio控件的句柄。"
    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=13,0,0,0
Public Property Get Caption() As String
Attribute Caption.VB_Description = "返回/设置Radio控件的Caption属性。"
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    Call SetAccessKeys
    Call UserControl_Resize            'Redraw(0, True) '####(0, True)
    PropertyChanged "Caption"
End Property
'******************************************************************************************
Public Property Get cPointColor() As OLE_COLOR                      '中间点的颜色
Attribute cPointColor.VB_Description = "返回/设置在自定义下的中心点的颜色。"
    cPointColor = m_cPointColor
End Property
Public Property Let cPointColor(ByVal New_cPointColor As OLE_COLOR)
    m_cPointColor = New_cPointColor
    Call UserControl_Resize            'Redraw(0, True) '####(0, True)
    PropertyChanged "cPointColor"
End Property
Public Property Get FrameColor() As OLE_COLOR                         '外圈的颜色
Attribute FrameColor.VB_Description = "返回/设置在自定义时的圆圈颜色。"
    FrameColor = m_FrameColor
End Property
Public Property Let FrameColor(ByVal New_FrameColor As OLE_COLOR)
    m_FrameColor = New_FrameColor
    Call UserControl_Resize            'Redraw(0, True) '####(0, True)
    PropertyChanged "FrameColor"
End Property
Public Property Get FillColor() As OLE_COLOR                          '外圈内的填充色
Attribute FillColor.VB_Description = "返回/设置自定义状态时的中间显示颜色。"
    FillColor = m_FillColor
End Property
Public Property Let FillColor(ByVal New_FillColor As OLE_COLOR)
    m_FillColor = New_FillColor
    Call UserControl_Resize            'Redraw(0, True) '####(0, True)
    PropertyChanged "FillColor"
End Property
'''*********************************************************************************************

'注意！不要删除或修改下列被注释的行！
'MemberInfo=21,0,0,1
Public Property Get RadioType() As RadioTypes
Attribute RadioType.VB_Description = "返回/设置Radio的风格种类。（1-XP 风格；2-自定义；3-VB标准风格；4-传统风格）"
    RadioType = m_RadioType
End Property

Public Property Let RadioType(ByVal New_RadioType As RadioTypes)
    m_RadioType = New_RadioType
    Call SetColors
    Call UserControl_Resize
    PropertyChanged "RadioType"
End Property
Public Property Get CustomRadioType() As CustomRadioTypes
Attribute CustomRadioType.VB_Description = "返回/设置自定义时的风格选项。（1-渐变；2-单色；3-翠绿）"
    CustomRadioType = m_CustomRadioType
End Property

Public Property Let CustomRadioType(ByVal New_CustomRadioType As CustomRadioTypes)
    m_CustomRadioType = New_CustomRadioType
    If m_CustomRadioType = [渐变] Then
       m_FrameColor = &HBC5C2C
       m_FillColor = RGB(142, 188, 245)
       m_cPointColor = &H53FF
    ElseIf m_CustomRadioType = [单色] Then
       m_FrameColor = &H0
       m_FillColor = RGB(254, 152, 1)
       m_cPointColor = &H0
    ElseIf m_CustomRadioType = [翠绿] Then
       m_FrameColor = ccDarkShadow
       m_FillColor = ccHighLight
       m_cPointColor = vbGreen
    End If
    Call SetColors
    Call UserControl_Resize
    PropertyChanged "CustomRadioType"
End Property
'注意！不要删除或修改下列被注释的行！
'MemberInfo=0,0,0,0
Public Property Get Value() As Boolean
Attribute Value.VB_Description = "返回/设置控件的状态值。"
    Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Boolean)
    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 = "返回/设置控件的焦点是否可见。"
    ShowFocusRect = showFocusR
End Property

Public Property Let ShowFocusRect(ByVal New_ShowFocusRect As Boolean)
    showFocusR = New_ShowFocusRect
    Call Redraw(lastStat, True)
    PropertyChanged "ShowFocusRect"
End Property
'**********************************************************************************************
Public Property Get ContainerHwnd() As Long
ContainerHwnd = UserControl.ContainerHwnd

End Property
'
'************************************************************************************************
'***********************************************************************************************
'为用户控件初始化属性
Private Sub UserControl_InitProperties()
'Dim lngContainerHandle As Long
    BackC = GetSysColor(COLOR_BTNFACE)
    ForeC = GetSysColor(COLOR_BTNTEXT)
    isEnabled = m_def_Enabled
    Set TextFont = Ambient.Font
    m_hWnd = m_def_hWnd
    m_Caption = Extender.Name                          ' m_def_Caption
    m_cPointColor = m_def_cPointColor
    m_FrameColor = m_def_FrameColor
    m_FillColor = m_def_FillColor
    showFocusR = m_def_ShowFocusRect
    lastStat = 0

    m_Value = m_def_Value
    m_RadioType = m_def_RadioType
    m_CustomRadioType = m_def_CustomRadioType
    m_BackStyle = m_def_BackStyle
'    UnCheckOther
'    lngContainerHandle = UserControl.ContainerHwnd
'    For Each Obj In Parent.Controls
'        If TypeOf Obj Is wwradio And Obj.Name <> Ambient.DisplayName Then
'            If Obj.ContainerHwnd = lngContainerHandle Then Obj.Value = False   'Obj.Group = lGroup And
'        End If
'    Next
End Sub
Private Sub UnCheckOther()