dlgsetring.bas

一个clock的 vb 源码

Attribute VB_Name = "DlgSetRing"
Option Explicit
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' 这里是闹铃设置对话框
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private hFont As Long
Private Label As clsLabel
Private Edit As New clsEdit
Private Button As New clsButton
Public ListView As New clsListView
Private DlgSetRing As New clsDialog
Private CommonDialog As clsCommonDialog
'------------------------------------------------------------------
Public EditClick As Boolean
Public RingData As New clsSaveRingData

Public Function CreateDlgSetRing(hWndParent As Long)  'hWndParent As Long
    Call DlgSetRing.CreateDialog(hWndParent, AddressOf DlgProc)
    Set DlgSetRing = Nothing
End Function

Private Function DlgProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_INITDIALOG
            Dim lpRect As RECT, hDesktop As Long
            hDesktop = GetDesktopWindow
            Call GetWindowRect(hDesktop, lpRect)
            Call MoveWindow(hwnd, (lpRect.Right - 432) / 2, (lpRect.Bottom - 264) / 2, 432, 264, 1)
            Call SendMessage(hwnd, WM_SETTEXT, 0, ByVal "闹铃设置")
            
            hFont = CreateFont(12, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, _
            OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
            DEFAULT_PITCH Or FF_DONTCARE, "宋体")
            
            Button.CreateButton hwnd, "新增(&N)", 1, 336, 23, 72, 20, hFont, WS_GROUP
            Button.CreateButton hwnd, "更改(&R)", 2, 336, 46, 72, 20, hFont, WS_DISABLED
            Button.CreateButton hwnd, "删除(&D)", 3, 336, 69, 72, 20, hFont, WS_DISABLED
            Button.CreateButton hwnd, "全部选中(&S)", 4, 336, 103, 72, 20, hFont
            Button.CreateButton hwnd, "全部取消(&E)", 5, 336, 126, 72, 20, hFont
            Button.CreateButton hwnd, "启动整点报时(&O)", 6, 20, 176, 108, 20, hFont, BS_AUTOCHECKBOX
            
            Edit.CreateEdit hwnd, 7, 193, 175, 172, 19, hFont, WS_GROUP
            Call SetFocus(Edit.hwnd(0))
            
            Button.CreateButton hwnd, "...", 8, 376, 175, 30, 20, hFont
            Button.CreateButton hwnd, "确定(&O)", 9, 166, 210, 72, 20, hFont, BS_DEFPUSHBUTTON Or WS_GROUP
            Button.CreateButton hwnd, "应用(&A)", 10, 250, 210, 72, 20, hFont
            Button.CreateButton hwnd, "取消(&C)", 11, 334, 210, 72, 20, hFont
            
            ListView.CreateListView hwnd, 12, 18, 22, 310, 124, WS_GROUP
            Call ListView.ListView_SetExtendedListViewStyleEx                       ' 扩展风格
            Call ListView.ListView_InsertColumn(ListView.hwnd, 1, "提醒方式", 110)  ' 列表头
            Call ListView.ListView_InsertColumn(ListView.hwnd, 2, "闹玲时间", 190)

            Call ListView.ListView_SetBkColor(ListView.hwnd, &HC0E0FF)          ' 控制背景色
            Call ListView.ListView_SetTextBkColor(&HC0E0FF)        ' 控制项目的背景色
            ListView_Load
            Call ListView.ListView_GetItem(1)
            Call ListView.ListView_GetItemText(1, 1)
            
            Set Label = New clsLabel
            Label.CreateLabel hwnd, "闹玲项目", 20, 5, hFont
            Label.CreateLabel hwnd, "报时", 20, 162, hFont
            Label.CreateLabel hwnd, "使用声音", 140, 179, hFont
            
            Call Form_Load(hwnd)
            EditClick = False
        Case WM_NOTIFY
            Dim nmList As NMLISTVIEW
            CopyMemory nmList, ByVal lParam, Len(nmList)
            If nmList.hdr.code = NM_CLICK Then
                If ListView.ListView_GetNextItem <> -1 Then
                    EnableWindow Button.hwnd(1), True
                    EnableWindow Button.hwnd(2), True
                Else
                    EnableWindow Button.hwnd(1), False
                    EnableWindow Button.hwnd(2), False
                End If
            End If
        
        Case WM_PAINT
            Dim lpPaint As PAINTSTRUCT
            Dim hDc As Long
            hDc = BeginPaint(hwnd, lpPaint)
                DrawFrame hDc, 8, 417, 10, 158
                DrawFrame hDc, 8, 416, 168, 201
                DrawButton hDc, 335, 409, 22, 44
                DrawButton hDc, 335, 409, 45, 67
                DrawButton hDc, 335, 409, 68, 90
                DrawButton hDc, 335, 409, 102, 124
                DrawButton hDc, 335, 409, 125, 147
                DrawButton hDc, 375, 407, 174, 196
                DrawButton hDc, 165, 239, 209, 231
                DrawButton hDc, 249, 323, 209, 231
                DrawButton hDc, 333, 407, 209, 231
            Call EndPaint(hwnd, lpPaint)

        Case WM_COMMAND
            Select Case wParam
                Case Is = 9   ' 确定按钮
                    Call SendMessage(hwnd, WM_COMMAND, 11, ByVal 0)
                Case Is = 11
                    Call SendMessage(hwnd, WM_CLOSE, 0, ByVal 0)
            End Select
        Case WM_CLOSE
            Set Edit = Nothing
            Set Label = Nothing
            Set Button = Nothing
            Set RingData = Nothing
            Set ListView = Nothing
            Set CommonDialog = Nothing
            Call DeleteObject(hFont)
            Call EndDialog(hwnd, 0)
        End Select
End Function

' Data

Public Function ListView_Load()
    Dim RegDataCount As Long     ' (闹铃时间方式，闹铃动作，星期)
    Dim I As Long, lpByte() As Byte             ' (二进制表示法 XX XX XX 分别为)
    Dim nText() As String, rText() As String, wText() As String, pText() As String
    Dim StrTime As String, RegNotify As String
    On Error GoTo Errors
    RegDataCount = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", "DataCount")

    ReDim nText(RegDataCount): ReDim wText(RegDataCount)
    ReDim rText(RegDataCount): ReDim pText(RegDataCount)
    For I = 1 To RegDataCount
        lpByte = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("Data" & I))
        nText(I) = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("Text" & I))
        rText(I) = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("RunExe" & I))
        wText(I) = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("WavFile" & I))
        pText(I) = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", CStr("Parameters" & I))
        '----------------------------------------------------------------------------------
            ' 翻译闹玲模式从(数值 ----->> 文字)
            ' 取通知方式(闹铃动作)二进制第一位然后根据(模式)
            
            Dim strNotifyMode As String
            
            strNotifyMode = RingData.InterpretNotifyMode(CLng(lpByte(1)))
            ' (I-1) :) 添加 ListView 项到底部(否则当按删除钮删除 listview 的项目会与 集合中的项目措开)
            
            If lpByte(0) > 0 Then ' 判断闹玲状态
                Call ListView.ListView_InsertItem(ListView.hwnd, (I - 1), strNotifyMode & nText(I), LVIS_SELCHECK)
            Else
                Call ListView.ListView_InsertItem(ListView.hwnd, (I - 1), strNotifyMode & nText(I), &H1000)
            End If
        '----------------------------------------------------------------------------------
            Dim strTimeMode As String
            strTimeMode = RingData.InterpretTimeMode(CLng(lpByte(2)), CLng(lpByte(3)), CLng(lpByte(6)), CStr(lpByte(7)), CLng(lpByte(8)), CLng(lpByte(9)))
        '----------------------------------------------------------------------------------
            StrTime = CStr(lpByte(4) & "时" & lpByte(5) & "分")
            Call ListView.ListView_SetItemText(ListView.hwnd, (I - 1), 1, StrTime & " (" & strTimeMode & ")")
        '----------------------------------------------------------------------------------
            ' 从注册表读入集合
            Call RingData.lngSaveRingMode(CLng(lpByte(1)), CLng(lpByte(2)), CLng(lpByte(10)))
            Call RingData.lngSaveRingTime(CLng(lpByte(3)), CLng(lpByte(4)), CLng(lpByte(5)))
         
            Call RingData.lngSaveRingDate(CLng(lpByte(6)), CLng(lpByte(7)), CLng(lpByte(8)), CLng(lpByte(9)))
            Call RingData.strSaveRingData(nText(I), rText(I), wText(I), pText(I))
    Next
        Exit Function
Errors:
        Exit Function
End Function

Public Function Form_Load(hDlg As Long)
    ' 从注册表中取 正点 报时设置写入对话框中
    Dim ButState As Long
    Dim strWavFile As String
    
    ButState = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "HourRing")
    If ButState <> 0 And IsNumeric(ButState) Then
        If ButState > 0 Then
            Call SendDlgItemMessage(hDlg, 6, BM_SETCHECK, BST_CHECKED, 0)
        Else
            Call SendDlgItemMessage(hDlg, 6, BM_SETCHECK, BST_UNCHECKED, 0)
        End If
    End If
    
    strWavFile = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "WavFile")
    If strWavFile <> vbNullString Then
        Call Edit.SetEditText(hDlg, 7, strWavFile)
    End If
End Function

Public Function Form_Unload(hDlg As Long)
    ' 关闭对话框时写将 正点 报时设置写入注册表
    HourRing = Button.GetButtonState(hDlg, 6)
    HourSoundFile = Edit.Text(hDlg, 7)
    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "HourRing", REG_DWORD, Button.GetButtonState(hDlg, 6))
    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "WavFile", REG_SZ, Edit.Text(hDlg, 7))
End Function



'Public Function ListView_UnLoad()
    'Dim lpData(8) As Byte
    'Dim lpValue As String
    'Dim lpAttr As SECURITY_ATTRIBUTES
    'Dim i As Long, hKey As Long
    'Dim strSubItemText As String, strWeekText As String
    
    'For i = 0 To ListView.ListView_GetItemCount - 1
        'Select Case Left$(ListView.ListView_GetItem(i), 1)
            'Case Is = "声": lpData(0) = 0
           ' Case Is = "文": lpData(0) = 1
          '  Case Is = "运": lpData(0) = 2
         '   Case Is = "重": lpData(0) = 3
        '    Case Is = "关": lpData(0) = 4
       ' End Select
        
      '  strSubItemText = ListView.ListView_GetItemText(i, 1)
     '   Select Case Mid$(strSubItemText, InStr(strSubItemText, "(") + 1, 2)
           ' Case Is = "每天": lpData(1) = 1
           ' Case Is = "每周": lpData(1) = 2
          '  Case Is = "每月": lpData(1) = 3
         '   Case Is = "每年": lpData(1) = 4
        '    Case Else: lpData(1) = 0
       ' End Select
        
        'Select Case Mid$(strSubItemText, InStr(strSubItemText, "(") + 2, 2)
           ' Case Is = "周日": lpData(2) = 0
          '  Case Is = "周一": lpData(2) = 1
           ' Case Is = "周二": lpData(2) = 2
          '  Case Is = "周三": lpData(2) = 3
         '   Case Is = "周四": lpData(2) = 4
         '   Case Is = "周五": lpData(2) = 5
        '    Case Is = "周六": lpData(2) = 6
       ' End Select
        'lpData(5) = ConversionNumber(2002)
       ' lpData(7) = 30
      '  lpValue = CStr("Data" & 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, lpValue, 0&, REG_BINARY, lpData(0), 8)
   ' Next
  '  Call RegCloseKey(hKey)
 '   Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", "DataCount", REG_DWORD, ListView.ListView_GetItemCount - 1)
'End Function

'Public Function ListView_UnLoad()
    'Dim lpData(5) As Byte
    'Dim lpValue As String
    'Dim lpAttr As SECURITY_ATTRIBUTES
    'Dim I As Long, hKey As Long, RenDataCount As Long
    
    'RegDataCount = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", "DataCount")
    
    'For I = 0 To ListView.ListView_GetItemCount - 1
            'lpValue = CStr("Data" & RegDataCount + 1)
            'lpData(0) = CByte(Ring(I).RingMode)
           ' lpData(1) = CByte(Ring(I).TimeMode)
          '  lpData(2) = CByte(Ring(I).wDayWeek)
         '   lpData(3) = CByte(Ring(I).RingDateTime.wHour)
        '    lpData(4) = CByte(Ring(I).RingDateTime.wMinute)
       '     lpData(5) = CByte(Ring(I).RingDateTime.wSecond)
      '
     '   Call RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)
    '    Call RegSetValueExAny(hKey, lpValue, 0&, REG_BINARY, lpData(0), 6)
   ' Next
  '  Call RegCloseKey(hKey)
 '   Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Data", "DataCount", REG_DWORD, ListView.ListView_GetItemCount - 1)
'End Function