frmmenu.frm

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

VERSION 5.00
Object = "{BA15ACB6-8B32-4ABF-AD1E-FA042F275322}#1.0#0"; "VsMenu.ocx"
Begin VB.Form frmMenu 
   BorderStyle     =   0  'None
   ClientHeight    =   555
   ClientLeft      =   2.45790e5
   ClientTop       =   2.46360e5
   ClientWidth     =   1890
   Icon            =   "frmMenu.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   555
   ScaleWidth      =   1890
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   Begin VB.FileListBox File1 
      Height          =   1530
      Left            =   2280
      Pattern         =   "*.bmp"
      TabIndex        =   0
      Top             =   570
      Width           =   2085
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   1620
      Top             =   90
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   3
      Left            =   870
      Top             =   45
   End
   Begin VsMenu.ctxVsMenu ctxVsMenu1 
      Left            =   0
      Top             =   0
      _ExtentX        =   900
      _ExtentY        =   900
      BmpCount        =   13
      Bmp:1           =   "frmMenu.frx":22782
      Key:1           =   "#totop"
      Bmp:2           =   "frmMenu.frx":22BAA
      Key:2           =   "#set"
      Bmp:3           =   "frmMenu.frx":22FD2
      Key:3           =   "#exit"
      Bmp:4           =   "frmMenu.frx":233FA
      Key:4           =   "#canmove"
      Bmp:5           =   "frmMenu.frx":23822
      Key:5           =   "#abb"
      Bmp:6           =   "frmMenu.frx":23C4A
      Key:6           =   "#sets"
      Bmp:7           =   "frmMenu.frx":24072
      Key:7           =   "#cclr"
      Bmp:8           =   "frmMenu.frx":2449A
      Key:8           =   "#cbkpic"
      Bmp:9           =   "frmMenu.frx":248C2
      Key:9           =   "#flist:0"
      Bmp:10          =   "frmMenu.frx":24CEA
      Key:10          =   "#m_alarm"
      Bmp:11          =   "frmMenu.frx":25112
      Key:11          =   "#canmovea"
      Bmp:12          =   "frmMenu.frx":2553A
      Key:12          =   "#hhhhh"
      Bmp:13          =   "frmMenu.frx":25962
      Key:13          =   "#erererwer"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DrawStyle       =   2
      MenuDrawStyle   =   2
      UserSelectedMenuBackColour=   16767676
      UserSelectedMenuBorderColour=   16711680
      UserTopMenuBackColour=   16761765
      UserTopMenuSelectedColour=   16769990
      UserTopMenuHotColour=   33023
      UserTopMenuHotBorderColour=   16711680
      UserMenuBorderColour=   8388608
      UserCheckBackColour=   15703909
      UserCheckBorderColour=   16711680
      UserGradientOne =   16707040
      UserGradientTwo =   15905926
      UserUseGradient =   -1  'True
      UserSideBarColour=   16711680
   End
   Begin VB.Menu m_pop 
      Caption         =   "a"
      Begin VB.Menu canmovea 
         Caption         =   "移动"
         Checked         =   -1  'True
      End
      Begin VB.Menu totop 
         Caption         =   "置顶          "
         Checked         =   -1  'True
      End
      Begin VB.Menu wwwww 
         Caption         =   "-"
      End
      Begin VB.Menu erererwer 
         Caption         =   "提醒"
         Begin VB.Menu m_alarm 
            Caption         =   "定制提醒"
         End
         Begin VB.Menu suretoshow 
            Caption         =   "开启健康提醒"
         End
      End
      Begin VB.Menu eeeeeeeeeeeee 
         Caption         =   "-"
      End
      Begin VB.Menu sets 
         Caption         =   "设置"
         Begin VB.Menu set 
            Caption         =   "时钟设置"
         End
         Begin VB.Menu cclr 
            Caption         =   "颜色选择"
         End
         Begin VB.Menu autor 
            Caption         =   "随系统加载"
            Checked         =   -1  'True
         End
      End
      Begin VB.Menu cbkpic 
         Caption         =   "背景选择"
         Begin VB.Menu flist 
            Caption         =   "浏览.."
            Index           =   0
         End
      End
      Begin VB.Menu ewewer 
         Caption         =   "-"
      End
      Begin VB.Menu hhhhh 
         Caption         =   "帮助"
      End
      Begin VB.Menu abb 
         Caption         =   "关于"
      End
      Begin VB.Menu ddddd 
         Caption         =   "-"
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ii As Integer
Private Sub abb_Click()
frmAbout.Show
frmAbout.Label1.Caption = Decode("苯褥箭势尤vrrbbb咯贰得子尤褥箭、纬粳vrrbbb得寿颧徐咳咳矣子尤贰不赋峙+椽菠嘎褥箭、")

End Sub ' wssccc's qq  151884336

Private Sub autor_Click()
If autor.Checked = True Then
    Unstall
    autor.Checked = False
    AutoRun = False
Else
    Install
    autor.Checked = True
    AutoRun = True

End If

End Sub ' wssccc's qq  151884336

Private Sub canmovea_Click()
If CanMove = True Then
    CanMove = False
    canmovea.Checked = False
    
Else
    CanMove = True
    canmovea.Checked = True
End If
End Sub ' wssccc's qq  151884336

Private Sub cclr_Click()
frmCClr.Show
End Sub ' wssccc's qq  151884336

Private Sub exit_Click()
Unload frmMain
End Sub ' wssccc's qq  151884336

Private Sub flist_Click(Index As Integer)
If Index = 0 Then
frmConfig.Show
DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents: DoEvents
frmConfig.isButton3_Click
Else
BkPic = App.Path & "\graph\" & flist(Index).Caption & ".bmp"
SaveSettings
frmMain.RefreshA
End If
End Sub ' wssccc's qq  151884336

Private Sub Form_Load()
suretoshow.Checked = EnHhelp
canmovea.Checked = CanMove
totop.Checked = Ontop
If Ontop = True Then
AlwaysOnTop.AlwaysOnTop frmMain, True
Else
AlwaysOnTop.AlwaysOnTop frmMain, False
End If
frmMain.Show
AddIcon
If AutoRun = True Then
    Install
    autor.Checked = True
Else
Unstall
autor.Checked = False
End If

On Error Resume Next
File1.Path = App.Path & "\graph"
frmHhlp.Show
'If CanMove = False Then SetWindowPos frmMain.hwnd, HWND_NOTOPMOST, frmMain.Top / Screen.TwipsPerPixelY, frmMain.Left / Screen.TwipsPerPixelX, frmMain.Width / Screen.TwipsPerPixelX, frmMain.Height / Screen.TwipsPerPixelY, FLAGS
RefreshFlist
End Sub ' wssccc's qq  151884336


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dim lMsg As Single
  lMsg = X / Screen.TwipsPerPixelX
    If lMsg = &H205 Then
    PopupMenu m_pop
    Knew = True

  End If
End Sub ' wssccc's qq  151884336

Private Sub Form_Unload(Cancel As Integer)
TrayIcon.DelIcon

End Sub ' wssccc's qq  151884336

Private Sub hhhhh_Click()
frmhelp.Show
End Sub ' wssccc's qq  151884336

Private Sub m_alarm_Click()
frmAlarmSet.Show
End Sub ' wssccc's qq  151884336

Private Sub set_Click()
frmConfig.Show
End Sub ' wssccc's qq  151884336

Private Sub suretoshow_Click()
If EnHhelp = True Then
    EnHhelp = False
    suretoshow.Checked = False
    
Else
    EnHhelp = True
    suretoshow.Checked = True
End If
SaveSettings
End Sub ' wssccc's qq  151884336

Private Sub Timer1_Timer()
If ii < HowTM Then
ii = ii + 2
frmMain.TM ii
Else
Timer1.Enabled = False
ii = 0
End If
End Sub ' wssccc's qq  151884336

Private Sub Timer2_Timer()

If HowTM > 10 Then
HowTM = HowTM - 2
frmMain.TM HowTM
Else
Timer1.Enabled = False
DelIcon
End
End If
End Sub ' wssccc's qq  151884336

Private Sub Timer3_Timer()
RefreshFlist
End Sub ' wssccc's qq  151884336

Private Sub totop_Click()
If Ontop = True Then
    'SetWindowPos frmMain.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE
    'SetWindowPos frmMain.hwnd, HWND_TOPMOST, frmMain.Top / Screen.TwipsPerPixelY, frmMain.Left / Screen.TwipsPerPixelX, Me.Width / Screen.TwipsPerPixelX, frmMain.Height / Screen.TwipsPerPixelY, FLAGS
    AlwaysOnTop.AlwaysOnTop frmMain, False
    Ontop = False
    totop.Checked = False
    
Else
    'SetWindowPos frmMain.hwnd, HWND_TOPMOST, 50, 50, 50, 50, SWP_NOMOVE And SWP_NOSIZE
    'SetWindowPos frmMain.hwnd, HWND_NOTOPMOST, frmMain.Top / Screen.TwipsPerPixelY, frmMain.Left / Screen.TwipsPerPixelX, Me.Width / Screen.TwipsPerPixelX, frmMain.Height / Screen.TwipsPerPixelY, FLAGS
    AlwaysOnTop.AlwaysOnTop frmMain, True
    Ontop = True
    totop.Checked = True
End If

End Sub ' wssccc's qq  151884336

Sub RefreshFlist()
On Error Resume Next
Dim U
For U = 1 To flist.Count - 1
Unload flist(U)
Next
U = 0
If File1.ListCount <> 0 Then
 For U = 0 To 25
 If File1.List(U) <> "" Then
    Load flist(U + 1)
    flist(U + 1).Caption = Mid(File1.List(U), 1, Len(File1.List(U)) - 4)
    flist(U + 1).Visible = True
    End If
    Next
End If

End Sub ' wssccc's qq  151884336