frmtrayicon.frm

传奇网吧伴侣源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTrayIcon 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   Icon            =   "frmTrayIcon.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Visible         =   0   'False
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmTrayIcon.frx":0E42
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmTrayIcon.frx":1C96
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmTrayIcon.frx":2AEA
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmTrayIcon.frx":40B6
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuOpen 
         Caption         =   "&Open"
      End
   End
   Begin VB.Menu mnuPopup 
      Caption         =   "&Popup"
      Begin VB.Menu mnuHomePage 
         Caption         =   "传奇科技网站"
      End
      Begin VB.Menu mnuSysSet 
         Caption         =   "系统设置"
      End
      Begin VB.Menu mnuRestore 
         Caption         =   "精彩网址推荐"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
         Shortcut        =   {F12}
      End
   End
End
Attribute VB_Name = "frmTrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit



Public LastState As Integer

Private WithEvents m_Menu As EnhancedMenu
Attribute m_Menu.VB_VarHelpID = -1

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
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&





Private Sub Form_Load()
On Error GoTo ErrCode8:

Me.Hide
SetTrayTip "传奇设计"

'Me.Icon = LoadResPicture(101, 1)
    Set m_Menu = New EnhancedMenu
    m_Menu.Subclass hwnd
    Set m_Menu(2).SubMenu(1).Picture = ImageList1.ListImages(2).Picture
    Set m_Menu(2).SubMenu(2).Picture = ImageList1.ListImages(1).Picture
    Set m_Menu(2).SubMenu(3).Picture = ImageList1.ListImages(3).Picture
    Set m_Menu(2).SubMenu(4).Picture = ImageList1.ListImages(4).Picture
    
AddToTray Me, mnuPopup

Exit Sub
ErrCode8:
MsgBox "传奇网吧伴侣系统托盘与Xp风格菜单无法正常启动，请重新下载或安装！", , "系统托盘启动出错"
Unload Me
End Sub




Private Sub Form_Paint()
Me.Hide
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim Pass As String
frmGirl.Timer1.Enabled = False
Pass = InputBox("为了保证软件的正常运行，需要输入正确的密码才能进入！请在下面输入密码：", "请输入密码！")
    If Pass <> "legend" Then
        frmGirl.Timer1.Enabled = True
        Cancel = 2
        Exit Sub
    Else
        RemoveFromTray
        Unload frmGirl
        Unload frmBubble
        Unload frmSysSet
        Unload ADbar
        End If
End Sub

Private Sub mnuExit_Click()

Unload Me
End Sub

Public Property Get Menu() As EnhancedMenu
    Set Menu = m_Menu
End Property
'XP风格菜单的按键判断
Private Sub m_Menu_ItemSelect(MenuObject As OfficeXPMenu.MenuItem)
'MsgBox MenuObject.Caption
On Error GoTo Err:
'根据不同标题调用不同函数
If MenuObject.Caption = "退出" Then mnuExit_Click
If MenuObject.Caption = "传奇科技网站" Then mnuHomePage_Click
If MenuObject.Caption = "系统设置" Then mnuSysSet_Click
If MenuObject.Caption = "精彩网址推荐" Then mnuRestore_Click
Exit Sub
Err:
'Unload Me
End Sub

Private Sub mnuHomePage_Click()
'打开传奇主页
Call ShellExecute(Me.hwnd, "Open", "http://chuan-qi.6to23.com", "", App.Path, 1)
End Sub

Private Sub mnuRestore_Click()
'打开传奇精彩网址推荐页
Call ShellExecute(Me.hwnd, "Open", "http://asp.6to23.com/cqsjs/goodurl.htm", "", App.Path, 1)
End Sub

Private Sub mnuSysSet_Click()
Dim Pass As String
'使用密码退出！
frmGirl.Timer1.Enabled = False
Pass = InputBox("为了保证软件的正常运行，需要输入正确的密码才能进入！请在下面输入密码：", "请输入密码！")
If Pass = "legend" Then frmSysSet.Show
frmGirl.Timer1.Enabled = True
End Sub