module1.bas

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

Attribute VB_Name = "Module1"
Public Declare Function ReleaseCapture Lib "User32" () As Long
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_MEMORY = &H4
Dim SoundBuffer() As Byte
Dim wFlags As Long
Dim Increase As Long
Dim cFile As Currency
Public Cnn As Integer
Public Keystr As String
Public Declare Function MCISendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal LPSTRCOMMAND As Any, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Knew As Boolean
Public LastTime
Public Hlast
Public Const SND_LOOP = &H8

'-------------------------------Setting values---------------------------
Public AutoRun As Boolean
Public EnHhelp As Boolean
Public CanMove As Boolean
Public Ontop As Boolean
Public frmTop As Integer
Public frmleft As Integer
Public Hline As Long
Public Mline As Long
Public Sline As Long
Public Ks As Long
Public HowTM As Integer
Public BkPic As String
Public ClockStr As String
Public SoundFile As String
Public PlaySound As Boolean

Public Sub LoadSettings()
'----------------------Load ClockStrings -----------------------------
On Error Resume Next
Dim Li
Dim sStr As String
Li = 1
Do While Trim(GetSetting("Reminder", "Alarms", sStr)) <> vbNullString
    sStr = Trim(str(Li))
   Dim Tmp As String
   Tmp = GetSetting("Reminder", "Alarms", sStr)
   If Trim(Tmp) <> "" Then
   ClockStr = ClockStr & Tmp & vbCrLf
   DoEvents
   End If
      Li = Li + 1
   Loop


'----------------------Load Setting values -----------------------------


BkPic = GetSetting("Reminder", "Settings", "BkPic", vbNullString)
CanMove = GetSetting("Reminder", "Settings", "canmove", True)
Ontop = GetSetting("Reminder", "Settings", "ontop", True)
frmTop = GetSetting("Reminder", "Settings", "frmtop")
frmleft = GetSetting("Reminder", "Settings", "frmleft")
Hline = GetSetting("Reminder", "Settings", "Hline", &HFFFFFF)
Mline = GetSetting("Reminder", "Settings", "Mline", &HFFFFFF)
Sline = GetSetting("Reminder", "Settings", "Sline", &HFFFFFF)
Ks = GetSetting("Reminder", "Settings", "Ks", &HFFFFFF)
HowTM = GetSetting("Reminder", "Settings", "HowTM", 255)
AutoRun = GetSetting("Reminder", "Settings", "autorun", False)
SoundFile = GetSetting("Reminder", "Settings", "SoundFile", App.Path & "\sounds\msg.wav")
PlaySound = GetSetting("Reminder", "Settings", "PlaySound", True)
EnHhelp = GetSetting("Reminder", "Settings", "EnableHealthHelp", True)

On Error Resume Next
wFlags = SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY
MCISendString "close MyWav", vbNullString, 0, 0
MCISendString "open " & SoundFile & " alias MyWav", vbNullString, 0, 0

End Sub ' wssccc's qq  151884336

Public Sub SaveSettings()
SaveSetting "Reminder", "Settings", "canmove", CanMove
SaveSetting "Reminder", "Settings", "ontop", Ontop
SaveSetting "Reminder", "Settings", "frmtop", frmMain.Top
SaveSetting "Reminder", "Settings", "frmleft", frmMain.Left
SaveSetting "Reminder", "Settings", "Hline", Hline
SaveSetting "Reminder", "Settings", "Mline", Mline
SaveSetting "Reminder", "Settings", "Sline", Sline
SaveSetting "Reminder", "Settings", "Ks", Ks
SaveSetting "Reminder", "Settings", "HowTM", HowTM
SaveSetting "Reminder", "Settings", "BkPic", BkPic
SaveSetting "Reminder", "Settings", "AutoRun", AutoRun
SaveSetting "Reminder", "Settings", "SoundFile", SoundFile
SaveSetting "Reminder", "Settings", "PlaySound", PlaySound
SaveSetting "Reminder", "Settings", "EnableHealthHelp", EnHhelp

End Sub ' wssccc's qq  151884336


Public Sub ShowAlm(sTime As String, Info As String)
    frmAlmAlert.Show
    frmAlmAlert.title.Caption = sTime & "的闹钟"
    frmAlmAlert.Text1.Text = Info
    frmAlmAlert.Play
    'AlwaysOnTop.AlwaysOnTop frmAlmAlert, True
'
'Public Function Encode(str As String)
'Dim Tmp As String
'For i = 1 To Len(str)
'Tmp = Tmp & Chr((Asc(Mid(str, i, 1)) Xor 78) - 1)
' Next
' Encode = Tmp
'End Function
'

End Sub ' wssccc's qq  151884336

Public Sub CheckAlm()
Dim NowTime As String
If Minute(Now) < 10 Then
    NowTime = Hour(Now) & ":0" & Minute(Now)
    Else
    NowTime = Hour(Now) & ":" & Minute(Now)
End If
If InStr(ClockStr, NowTime) <> 0 Then
    If LastTime <> NowTime Then
       Knew = False
       LastTime = NowTime
       
     End If
    
      Dim tTime As String
      Dim Info As String
      Dim Tmp As String
      Dim Posi As Integer
      Posi = InStr(ClockStr, NowTime)
      Do While Posi < Len(ClockStr) And Asc(Mid(ClockStr, Posi, 1)) <> 13
        Tmp = Tmp & Mid(ClockStr, Posi, 1)
        Posi = Posi + 1
        DoEvents
        Loop
        tTime = Mid(Tmp, 1, InStr(Tmp, "!") - 1)
        Info = Mid(Tmp, InStr(Tmp, "!") + 1, Len(Tmp))

      If Knew = False Then ShowAlm tTime, Info
  End If

End Sub ' wssccc's qq  151884336