📄 frmalarm.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmAlarmSet
BorderStyle = 0 'None
Caption = "闹钟"
ClientHeight = 4755
ClientLeft = 0
ClientTop = 0
ClientWidth = 6795
Icon = "frmAlarm.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4755
ScaleWidth = 6795
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00DCC1AD&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 5610
Picture = "frmAlarm.frx":038A
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 9
Top = 60
Width = 240
End
Begin MSComctlLib.ImageList ImageList1
Left = 6210
Top = 1440
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmAlarm.frx":0714
Key = "wwwwwww"
Object.Tag = "q"
EndProperty
EndProperty
End
Begin Reminder.XPContainer XPContainer1
Height = 4035
Left = 0
TabIndex = 0
Top = 0
Width = 6315
_ExtentX = 11139
_ExtentY = 7117
Caption = "闹钟"
Begin VB.PictureBox isButton1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H00DCC1AD&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 5880
Picture = "frmAlarm.frx":0AAE
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 8
Top = 60
Width = 240
End
Begin Reminder.isButton isButton4
Height = 375
Left = 2640
TabIndex = 7
Top = 420
Width = 1125
_ExtentX = 1984
_ExtentY = 661
Icon = "frmAlarm.frx":0E38
Style = 8
Caption = "选择声音"
CaptionAlign = 2
iNonThemeStyle = 0
Tooltiptitle = ""
ToolTipIcon = 0
ToolTipType = 1
ttForeColor = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaskColor = 0
End
Begin Reminder.XpCheckBox ifPlay
Height = 255
Left = 3960
TabIndex = 5
Top = 480
Width = 1365
_ExtentX = 2408
_ExtentY = 450
Value = 1
Caption = "CheckBox1"
BackColor = 16577775
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Reminder.isButton isButton3
Height = 375
Left = 1740
TabIndex = 4
Top = 420
Width = 855
_ExtentX = 1508
_ExtentY = 661
Icon = "frmAlarm.frx":11D2
Style = 8
Caption = "刷新 "
CaptionAlign = 2
iNonThemeStyle = 0
BackColor = 16443612
Tooltiptitle = "提示"
ToolTipIcon = 1
ToolTipType = 1
ttForeColor = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaskColor = 0
End
Begin Reminder.isButton bDel
Height = 375
Left = 930
TabIndex = 3
Top = 420
Width = 825
_ExtentX = 1455
_ExtentY = 661
Icon = "frmAlarm.frx":156C
Style = 8
Caption = "删除 "
CaptionAlign = 2
iNonThemeStyle = 0
BackColor = 16443612
Tooltiptitle = "提示"
ToolTipIcon = 1
ToolTipType = 1
ttForeColor = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaskColor = 0
End
Begin Reminder.isButton bAdd
Height = 375
Left = 90
TabIndex = 2
Top = 420
Width = 855
_ExtentX = 1508
_ExtentY = 661
Icon = "frmAlarm.frx":1906
Style = 8
Caption = "添加 "
CaptionAlign = 2
iNonThemeStyle = 0
BackColor = 16443612
Tooltiptitle = "提示"
ToolTipIcon = 1
ToolTipType = 1
ttForeColor = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MaskColor = 0
End
Begin MSComctlLib.ListView AlmList
Height = 2835
Left = 90
TabIndex = 1
Top = 1110
Width = 6105
_ExtentX = 10769
_ExtentY = 5001
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
HideColumnHeaders= -1 'True
FullRowSelect = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = 16577775
Appearance = 0
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "时间"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "信息"
Object.Width = 7408
EndProperty
End
Begin VB.Shape Shape1
BorderColor = &H00DCC1AD&
Height = 2895
Left = 60
Top = 1080
Width = 6165
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "已设闹钟:"
Height = 285
Left = 90
TabIndex = 6
Top = 870
Width = 1065
End
End
End
Attribute VB_Name = "frmAlarmSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const LVM_FIRST = &H1000&
Const LVM_HITTEST = LVM_FIRST + 18
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type LVHITTESTINFO
pt As POINTAPI
Flags As Long
iItem As Long
iSubItem As Long
End Type
Dim m_lCurItemIndex As Long
Dim sIndex As Long
Private Sub AlmList_DblClick()
If sIndex <> 0 Then
frmAddAlm.Show
frmAddAlm.XPContainer1.Caption = "修改闹钟"
frmAddAlm.isButton1.Caption = "确定"
frmAddAlm.Text1.Text = AlmList.ListItems(sIndex).Text
frmAddAlm.Text2.Text = AlmList.ListItems(sIndex).SubItems(1)
frmAddAlm.eMode.Text = sIndex
End If
End Sub ' wssccc's qq 151884336
Private Sub AlmList_ItemClick(ByVal Item As MSComctlLib.ListItem)
sIndex = Item.Index
End Sub ' wssccc's qq 151884336
'Private Sub AlmList_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' Dim lvhti As LVHITTESTINFO
' Dim lItemIndex As Long
'
' lvhti.pt.X = X / Screen.TwipsPerPixelX
' lvhti.pt.Y = Y / Screen.TwipsPerPixelY
' lItemIndex = SendMessage(AlmList.hwnd, LVM_HITTEST, 0, lvhti) + 1
'
' If m_lCurItemIndex <> lItemIndex Then
' m_lCurItemIndex = lItemIndex
' If m_lCurItemIndex = 0 Then
' TT.Destroy
' Else
' TT.title = AlmList.ListItems(m_lCurItemIndex).Text & "的闹钟"
' TT.TipText = AlmList.ListItems(m_lCurItemIndex).SubItems(1)
' TT.Create AlmList.hwnd
' End If
' End If
'end sub ' wssccc's qq 151884336
Private Sub bAdd_Click()
frmAddAlm.Show vbModal
'AlwaysOnTop.AlwaysOnTop frmAddAlm, True
End Sub ' wssccc's qq 151884336
Private Sub bDel_Click()
On Error Resume Next
'Dim A, S
'S = AlmList.SelectedItem.Index
'For A = 0 To AlmList.ListItems.Count
'If AlmList.ListItems(A).Selected = True Then AlmList.ListItems.Remove S
'Next
If sIndex = 0 Then sIndex = 1
AlmList.ListItems.Remove sIndex
SaveAlmItem
End Sub ' wssccc's qq 151884336
Private Sub Form_Load()
sIndex = 1
XPContainer1.hhhw = Me.hwnd
Me.Width = XPContainer1.Width
Me.Height = XPContainer1.Height
ifPlay.Caption = "开启闹钟声音"
ifPlay.Value = 0 - PlaySound
LoadAlmItem
End Sub ' wssccc's qq 151884336
Private Sub Form_Unload(Cancel As Integer)
PlaySound = 0 - ifPlay.Value
SaveSettings
End Sub ' wssccc's qq 151884336
Private Sub isButton1_Click()
SaveAlmItem
PlaySound = 0 - ifPlay.Value
SaveSettings
Unload Me
End Sub ' wssccc's qq 151884336
Sub LoadAlmItem()
On Error Resume Next
AlmList.ListItems.Clear
Dim Li
Dim sStr As String
Li = 1
Do While Trim(GetSetting("Reminder", "Alarms", sStr)) <> vbNullString
sStr = Trim(str(Li))
Dim Items As ListItem
Dim tTime As String
Dim Info As String
Dim Tmp As String
Tmp = GetSetting("Reminder", "Alarms", sStr)
If Trim(Tmp) <> "" Then
Set Items = AlmList.ListItems.Add
tTime = Mid(Tmp, 1, InStr(Tmp, "!") - 1)
Info = Mid(Tmp, InStr(Tmp, "!") + 1, Len(Tmp))
Items.Text = tTime
Items.SubItems(1) = Info
Items.SmallIcon = "wwwwwww"
DoEvents
End If
Li = Li + 1
Loop
End Sub ' wssccc's qq 151884336
Sub SaveAlmItem()
On Error Resume Next
Dim hKey As Long
RegCreateKey HKEY_CURRENT_USER, "Software\VB and VBA Program Settings\Reminder", hKey
RegDeleteKey hKey, "Alarms"
RegCloseKey hKey
Dim Li As Integer
ClockStr = vbNullString
For Li = 1 To AlmList.ListItems.Count
SaveSetting "Reminder", "Alarms", Li, AlmList.ListItems(Li).Text & "!" & AlmList.ListItems(Li).SubItems(1)
ClockStr = ClockStr & AlmList.ListItems(Li).Text & "!" & AlmList.ListItems(Li).SubItems(1) & vbCrLf
Next
End Sub ' wssccc's qq 151884336
Private Sub isButton2_Click()
SaveAlmItem
End Sub ' wssccc's qq 151884336
Private Sub isButton3_Click()
LoadAlmItem
End Sub ' wssccc's qq 151884336
Private Sub isButton4_Click()
frmConfig.Show
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
frmConfig.isButton4_Click
End Sub ' wssccc's qq 151884336
Private Sub Picture1_Click()
Me.WindowState = 1
End Sub ' wssccc's qq 151884336
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -