frmaddalm.frm

一款漂亮的闹钟制作界面,希望能给你们带来帮助.

VERSION 5.00
Begin VB.Form frmAddAlm 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   3345
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4485
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   3345
   ScaleWidth      =   4485
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin Reminder.XPContainer XPContainer1 
      Height          =   2625
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   4245
      _ExtentX        =   7488
      _ExtentY        =   4630
      Caption         =   "添加闹钟"
      Begin Reminder.isButton isButton2 
         Height          =   330
         Left            =   2190
         TabIndex        =   7
         Top             =   2130
         Width           =   1200
         _ExtentX        =   2117
         _ExtentY        =   582
         Icon            =   "frmAddAlm.frx":0000
         Style           =   8
         Caption         =   "取消"
         IconAlign       =   0
         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.isButton isButton1 
         Default         =   -1  'True
         Height          =   330
         Left            =   870
         TabIndex        =   6
         Top             =   2130
         Width           =   1200
         _ExtentX        =   2117
         _ExtentY        =   582
         Icon            =   "frmAddAlm.frx":001C
         Style           =   8
         Caption         =   "添加"
         IconAlign       =   0
         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 VB.TextBox Text1 
         Appearance      =   0  'Flat
         Height          =   315
         Left            =   1080
         MaxLength       =   6
         TabIndex        =   3
         Text            =   "Text1"
         ToolTipText     =   "时分用"":""分隔"
         Top             =   540
         Width           =   2745
      End
      Begin VB.TextBox Text2 
         Appearance      =   0  'Flat
         Height          =   1005
         Left            =   1080
         TabIndex        =   2
         Text            =   $"frmAddAlm.frx":0038
         Top             =   1050
         Width           =   2745
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "时间设置:"
         Height          =   255
         Left            =   180
         TabIndex        =   5
         Top             =   570
         Width           =   825
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "提示信息:"
         Height          =   315
         Left            =   180
         TabIndex        =   4
         Top             =   1050
         Width           =   855
      End
   End
   Begin VB.TextBox eMode 
      Height          =   345
      Left            =   2400
      TabIndex        =   0
      Top             =   2940
      Visible         =   0   'False
      Width           =   1185
   End
End
Attribute VB_Name = "frmAddAlm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Op As Integer

Private Sub Form_Load()
XPContainer1.hhhw = Me.hwnd
Me.Width = XPContainer1.Width
Me.Height = XPContainer1.Height
Text1.Text = Hour(Now)
If Minute(Now) + 1 < 10 Then
Text1.Text = Hour(Now) & ":0" & Minute(Now) + 1
Else
Text1.Text = Hour(Now) & ":" & Minute(Now) + 1
End If
End Sub ' wssccc's qq  151884336


Private Sub isButton1_Click()
Dim Le, R, TTM As String
Le = Mid(frmAddAlm.Text1.Text, 1, InStr(frmAddAlm.Text1.Text, ":") - 1)
R = Mid(frmAddAlm.Text1.Text, InStr(frmAddAlm.Text1.Text, ":") + 1, Len(Text1.Text) - InStr(frmAddAlm.Text1.Text, ":"))
If InStr(Text1.Text, ":") = 0 Or Le > 23 Or R > 59 Or Len(Le) > 2 Or Len(R) > 2 Then
MsgBox "时间格式错误", vbInformation, "提示"
Else

If InStr(ClockStr, Text1.Text) <> 0 And eMode.Text = "" Then
MsgBox "这个时间已经设置过闹钟了!", vbInformation, "提示"
Else

If Le < 10 Then
TTM = "0" & Val(Le) & ":"
Else
TTM = Val(Le) & ":"
End If

If R < 10 Then
TTM = TTM & "0" & Val(R)
Else
TTM = TTM & Val(R)
End If

Dim L As ListItem
If eMode.Text = "" Then
Set L = frmAlarmSet.AlmList.ListItems.Add
L.Icon = "wwwwwww"
L.SmallIcon = "wwwwwww"
L.Text = TTM
L.SubItems(1) = Text2.Text
frmAlarmSet.SaveAlmItem
Unload Me
Else
Set L = frmAlarmSet.AlmList.ListItems(Val(eMode))
L.Text = TTM
L.SubItems(1) = Text2.Text
frmAlarmSet.SaveAlmItem
Unload Me
End If
End If
End If
End Sub ' wssccc's qq  151884336

Private Sub isButton2_Click()
Unload Me
End Sub ' wssccc's qq  151884336

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub ' wssccc's qq  151884336

Private Sub Text1_Change()
Dim Q As Integer
For Q = 1 To Len(Text1.Text)
  Check Mid(Text1.Text, Q, 1)
Next
Op = Text1.SelStart
End Sub ' wssccc's qq  151884336

Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub ' wssccc's qq  151884336

Sub Check(str As String)
On Error Resume Next
  Dim S As Integer
  For S = 48 To 57
   If Asc(str) = S Then Exit Sub
   Next
   If str = ":" Then Exit Sub
   Text1.Text = Replace(Text1.Text, str, "")
   
   Text1.SelStart = Op
End Sub ' wssccc's qq  151884336