clsringdata.cls

一个clock的 vb 源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSaveRingData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'======================================================================
'   XX         XX       XX       XX       XX       XX       XX      XX
'   ↓         ↓       ↓       ↓       ↓       ↓       ↓      ↓
'项目的状态 闹玲方式 闹玲时间   星期     小时     分钟      年      年
'    0          1        2        3        4        5        6       7
'=====================================================================
'    XX       XX        XX
'    ↓       ↓        ↓
'    月       日   开机是否运行  (闹玲是否启动)
'     8        9        10
'=====================================================================

'----------------------------------------------------------------------
'|用于存储闹铃设置的相关信息 {虽然集合费内存但是俺没办法，俺是笨小孩} |
'----------------------------------------------------------------------
'|{如果你有啥新招可别忘了跟俺讲}。对了俺还搞不懂公历转农历的算法，俺还|
'----------------------------------------------------------------------
'|有好多多问题呦…………{这问提俺可是想了n 天，想的吃不好、睡不着头、 |
'----------------------------------------------------------------------
'|发掉了X X 根，俺现在才知道为什么别人说聪明的脑袋不长毛毛}
'----------------------------------------------------------------------
Dim ItemCheckState As Collection
Dim NotifyMode As Collection          ' 闹玲方式
Dim TimeMode As Collection            ' 闹玲时间
Dim wDayWeek As Collection            ' 星期
Dim wHour As Collection               ' 小时
Dim wMinute As Collection             ' 分钟
Dim wYear As Collection               ' 年
Dim wYear1 As Collection               ' 年1
Dim wMonth As Collection              ' 月
Dim wDay As Collection                ' 日
Dim OpenRun As Collection             ' 开机是否运行


Dim NotifyText As Collection          ' 提示信息
Dim RunExe As Collection              ' 执行程序
Dim WavFile As Collection             ' 自定义声音
Dim Parameters As Collection          ' 参数
Private sKey As String

Public Function lngSaveRingMode(lngNotifyMode As Long, lngTimeMode As Long, lngOpenRun As Long, Optional lngBefore As Variant)
    Call NotifyMode.Add(lngNotifyMode, , lngBefore)
    Call TimeMode.Add(lngTimeMode, , lngBefore)
    Call OpenRun.Add(lngOpenRun, , lngBefore)
End Function

Public Function lngSaveRingTime(lngWeek As Long, lngHour As Integer, lngMinute As Integer, Optional lngBefore As Variant)
    Call wDayWeek.Add(lngWeek, , lngBefore)
    Call wHour.Add(lngHour, , lngBefore)
    Call wMinute.Add(lngMinute, , lngBefore)
End Function

Public Function lngSaveRingDate(lngYear As Integer, lngYear1 As Integer, lngMonth As Integer, lngwDay As Integer, Optional lngBefore As Variant)
    Call wYear.Add(lngYear, , lngBefore)
    Call wYear1.Add(lngYear1, , lngBefore)
    Call wMonth.Add(lngMonth, , lngBefore)
    Call wDay.Add(lngwDay, , lngBefore)
End Function

Public Function strSaveRingData(strNotifyText As String, strRunExe As String, strWavFile As String, strParameters As String, Optional lngBefore As Variant)           ' 参数)
    Call NotifyText.Add(strNotifyText, , lngBefore)
    Call RunExe.Add(strRunExe, , lngBefore)
    Call WavFile.Add(strWavFile, , lngBefore)              ' 自定义声音 执行程序
    Call Parameters.Add(strParameters, , lngBefore)
End Function

Public Function lngSaveItemState(lngItemState As Long)
    Call ItemCheckState.Add(lngItemState)
End Function

Public Property Get GetItemState(Index As Long) As Long
    GetItemState = ItemCheckState.Item(Index)
End Property

Public Property Get GetNotifyMode(Index As Long)
    GetNotifyMode = NotifyMode.Item(Index)
End Property

Public Property Get GetTimeMode(Index As Long)
    GetTimeMode = TimeMode.Item(Index)
End Property

Public Property Get GetOpenRun(Index As Long)
    GetOpenRun = OpenRun.Item(Index)
End Property

Public Property Get GetwDayWeek(Index As Long)
    GetwDayWeek = wDayWeek.Item(Index)
End Property

Public Property Get GetwHour(Index As Long) As Integer
    GetwHour = wHour.Item(Index)
End Property

Public Property Get GetwMinute(Index As Long) As Integer
    GetwMinute = wMinute.Item(Index)
End Property

Public Property Get GetwYear(Index As Long) As String
    GetwYear = wYear1.Item(Index)
    If Len(GetwYear) = 1 Then
        GetwYear = wYear.Item(Index) & 0 & GetwYear
    Else
        GetwYear = wYear.Item(Index) & GetwYear
    End If
End Property

Public Property Get GetwMonth(Index As Long) As Integer
    GetwMonth = wMonth.Item(Index)
End Property

Public Property Get GetwDay(Index As Long) As Integer
    GetwDay = wDay.Item(Index)
End Property

Public Property Get GetNotifyText(Index As Long) As String
    GetNotifyText = NotifyText.Item(Index)
End Property

Public Property Get GetWavFile(Index As Long) As String
    GetWavFile = WavFile.Item(Index)
End Property

Public Property Get GetRunExe(Index As Long) As String
    GetRunExe = RunExe.Item(Index)
End Property

Public Property Get GetParameters(Index As Long) As String
    GetParameters = Parameters.Item(Index)
End Property
Public Function RemoveRingData(Index As Long)
    Call NotifyMode.Remove(Index)
    Call TimeMode.Remove(Index)
    Call wDayWeek.Remove(Index)
    Call wHour.Remove(Index)
    Call wMinute.Remove(Index)
    Call wYear.Remove(Index)
    Call wYear1.Remove(Index)
    Call wMonth.Remove(Index)
    Call wDay.Remove(Index)
    Call OpenRun.Remove(Index)
    Call NotifyText.Remove(Index)
    Call RunExe.Remove(Index)
    Call WavFile.Remove(Index)                ' 自定义声音 执行程序
    Call Parameters.Remove(Index)
End Function

Public Function RingItemCound() As Long
    RingItemCound = NotifyMode.Count
End Function

Private Function SaveRegString(X As Long)
    ' 如果是空的就不写注册表
    If NotifyText.Count > 0 Then
        If NotifyText.Item(X) <> vbNullString Then
            Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("Text" & X), REG_SZ, NotifyText.Item(X))
        End If
    End If
    If RunExe.Count > 0 Then
         If RunExe.Item(X) <> vbNullString Then
            Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("RunExe" & X), REG_SZ, RunExe.Item(X))
        End If
    End If
    If WavFile.Count > 0 Then
         If WavFile.Item(X) <> vbNullString And NotifyMode.Item(X) = 0 Then
            Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("WavFile" & X), REG_SZ, WavFile.Item(X))
        End If
    End If
    If Parameters.Count > 0 Then
         If Parameters.Item(X) <> vbNullString And NotifyMode.Item(X) = 2 Then
            Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("Parameters" & X), REG_SZ, Parameters.Item(X))
        End If
    End If
End Function

Public Function SaveRegRingData()
    ' 这里将集合中的数据写入注册表参见（二进制表示法）
    Dim lpData(10) As Byte
    Dim lpValueName As String
    Dim lpAttr As SECURITY_ATTRIBUTES
    Dim I As Long, hKey As Long
    On Error Resume Next

    DelRegkey HKEY_CURRENT_USER, "Software\Alarm Clock", "Data"
                                                ' Hex(4096)为1000  Hex(8192)为2000
    If ListView.ListView_GetItemCount > 0 Then  ' 4096 为未选择状态 8192 为选者状态
           
        For I = 1 To ListView.ListView_GetItemCount
            If ListView.ListView_GetItemState(I - 1) = 8192 Then ' 写入ListViewCheckbox
                lpData(0) = 1                                    ' 状态
            Else
                lpData(0) = 0
            End If
            lpData(1) = NotifyMode.Item(I)        ' 闹玲方式
            lpData(2) = TimeMode.Item(I)          ' 闹玲时间
            lpData(3) = wDayWeek.Item(I)          ' 星期
            lpData(4) = wHour.Item(I)             ' 小时
            lpData(5) = wMinute.Item(I)           ' 分钟
            lpData(6) = wYear.Item(I)             ' 年
            lpData(7) = wYear1.Item(I)             ' 年
            lpData(8) = wMonth.Item(I)            ' 月
            lpData(9) = wDay.Item(I)              ' 日
            lpData(10) = OpenRun.Item(I)
            
            Call SaveRegString(I)
            Call RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
            Call RegSetValueExAny(hKey, CStr("Data" & I), 0&, REG_BINARY, lpData(0), 11)
            Call RegCloseKey(hKey)
        Next
        Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", "DataCount", REG_DWORD, ListView.ListView_GetItemCount)
    End If
End Function

Public Function InterpretNotifyMode(NotifyValue As Long) As String
   ' 翻译闹玲模式从(数值 ----->> 文字)
   ' 取注册表中的 2 进制翻译成相应的文字以便插入ListView 中
   Select Case NotifyValue
        Case Is = 0: InterpretNotifyMode = "声音提示"
        Case Is = 1: InterpretNotifyMode = "文字提示"
        Case Is = 2: InterpretNotifyMode = "运行指定程序"
        Case Is = 3: InterpretNotifyMode = "重新启动计算机"
        Case Is = 4: InterpretNotifyMode = "关闭计算机"
    End Select
End Function

Public Function InterpretTimeMode(TimeValue As Long, WeekValue As Long, yValue As Long, yValue1 As String, MonthValue As Long, DayValue As Long) As String
     ' 取注册表中的 2 进制翻译成相应的文字以便插入ListView 中
    Select Case TimeValue
        Case Is = 1: ' 那个该 Kill IF 语句非要暂第一行
                     If Len(yValue1) = 1 Then: yValue1 = "0" & yValue1
                     InterpretTimeMode = yValue & yValue1 & "年" & MonthValue & "月" & DayValue & "日"
        Case Is = 2: InterpretTimeMode = "每天"
        Case Is = 3: InterpretDayWeek WeekValue
                     InterpretTimeMode = "每周" & InterpretDayWeek(WeekValue)
        Case Is = 4: InterpretTimeMode = "每月" & DayValue & "日"
        Case Is = 5: InterpretTimeMode = "每年" & MonthValue & "月" & DayValue & "日"
    End Select
End Function


Private Function InterpretDayWeek(wValue As Long) As String
     ' 取注册表中的 2 进制翻译成相应的文字以便插入ListView 中
    Select Case wValue ' 此项是TimeMode 的子项(如果不是每周就不用翻译星期)
        Case Is = 0: InterpretDayWeek = "日"
        Case Is = 1: InterpretDayWeek = "一"
        Case Is = 2: InterpretDayWeek = "二"
        Case Is = 3: InterpretDayWeek = "三"
        Case Is = 4: InterpretDayWeek = "四"
        Case Is = 5: InterpretDayWeek = "五"
        Case Is = 6: InterpretDayWeek = "六"
    End Select
End Function
                    
Private Sub Class_Initialize()
    Set ItemCheckState = New Collection
    Set NotifyMode = New Collection          ' 闹玲方式
    Set TimeMode = New Collection            ' 闹玲时间
    Set wDayWeek = New Collection            ' 星期
    Set wHour = New Collection              ' 小时
    Set wMinute = New Collection            ' 分钟
    Set wYear = New Collection              ' 年
    Set wYear1 = New Collection             ' 年1
    Set wMonth = New Collection             ' 月
    Set wDay = New Collection               ' 日
    Set OpenRun = New Collection
    Set NotifyText = New Collection          ' 提示信息
    Set RunExe = New Collection
    Set WavFile = New Collection             ' 自定义声音 执行程序
    Set Parameters = New Collection         ' 参数
End Sub

Private Sub Class_Terminate()
    ' 终于要清除这耗费资源的东东了 :)
    Set NotifyMode = Nothing          ' 闹玲方式
    Set TimeMode = Nothing             ' 闹玲时间
    Set wDayWeek = Nothing             ' 星期
    Set wHour = Nothing               ' 小时
    Set wMinute = Nothing             ' 分钟
    Set wYear = Nothing               ' 年
    Set wYear1 = Nothing            ' 年1
    Set wMonth = Nothing             ' 月
    Set wDay = Nothing              ' 日
    Set OpenRun = Nothing
    Set NotifyText = Nothing          ' 提示信息
    Set RunExe = Nothing
    Set WavFile = Nothing             ' 自定义声音 执行程序
    Set Parameters = Nothing        ' 参数
    Set ItemCheckState = Nothing
End Sub