frmbubble.frm

传奇网吧伴侣源码

         BackStyle       =   0  'Transparent
         Caption         =   "内容："
         Height          =   255
         Index           =   1
         Left            =   360
         TabIndex        =   7
         Top             =   1515
         Width           =   615
      End
      Begin VB.Label Label1 
         BackColor       =   &H00C0FFFF&
         BackStyle       =   0  'Transparent
         Caption         =   "    欢迎光临传奇网吧！我们的服务程序为您提供一些帮助，您需要："
         Height          =   615
         Index           =   0
         Left            =   150
         TabIndex        =   3
         Top             =   120
         Width           =   2535
      End
   End
End
Attribute VB_Name = "frmBubble"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'配置文件路径
Private iniPath As String
'气泡式窗口的背景色
Private Const BForm_BackColor = &HC0FFFF



Private Sub Form_Load()
On Error GoTo ErrCode4:
Dim i As Long
'调整窗口位置，使气泡式窗口总是出现在卡通人物的附近，形成"说话"的效果
MoveForm

'Label1(0).BackColor = BForm.BackColor
'读取用户设置
Check1(0).Value = bZDTime '整点报时
Check1(1).Value = bZYTime '重要提示
Check1(2).Value = bQQ '离开后自动关闭QQ
Check1(3).Value = bResetIE '将IE浏览器恢复到初始状态
Check1(4).Value = bAddress '快速保存网址
'如果重要提示中有提示内容，就读入提示内容并显示
If Len(sZYTimeString) > 1 Then Text1(0).Text = sZYTimeString
'读取重要提示的提示时间
Text1(1).Text = Right(Str(tZYTime.wHour), 2) '小时
Text1(2).Text = Right(Str(tZYTime.wMinute), 2) '分


'创建气泡式窗口
BForm.CreateRegion
'设定配置文件路径
iniPath$ = App.Path + "\SysSet.ini"
'如果配置文件存在，则读取"欢迎词"
If Dir(iniPath) <> "" Then
   Label1(0).Caption = GetFromINI("基本资料设置", "欢迎词", iniPath)
   Label1(0).Caption = Label1(0).Caption + "您需要："
End If

Exit Sub
ErrCode4:
MsgBox "传奇网吧伴侣气泡式窗口无法正常启动，请重新下载或安装！", , "气泡式窗口启动出错"
Unload Me

End Sub




Private Sub PopCancel_Click()
'退出
Unload Me
End Sub

Private Sub PopEnter_Click()
'保存用户设置，1是、0否
  bZDTime = Check1(0).Value '是否整点报时
  bZYTime = Check1(1).Value '是否重要提示
  sZYTimeString = Text1(0).Text '保存提示内容
  bQQ = Check1(2).Value '是否自动关闭QQ
  bResetIE = Check1(3).Value '是否初始化IE
  bAddress = Check1(4).Value '是否快速保存网址
  '保存提示时间
  tZYTime.wHour = Text1(1).Text '小时
  tZYTime.wMinute = Text1(2).Text '分
  
  Debug.Print tZYTime.wHour, tZYTime.wMinute
  '如果要初始化IE，就立刻执行
  If bResetIE = 1 Then ResetIE
  '如果需要整点报时和重要提示，就启动在FrmGirl（卡通人）窗口中的Timer2(时间控件)，检测并执行这两项任务
  If bZDTime = 1 Or bZYTime = 1 Then
  '每31秒检测一次，设成大于30秒可以保证提示只出现一次
  frmGirl.Timer2.Interval = 31000
  frmGirl.Timer2.Enabled = True
  Else
  '停止检测
  frmGirl.Timer2.Enabled = False
  End If
  

  
  Unload Me
End Sub

Private Sub ResetIE()
'上网时，经常会出现IE被恶意代码改得面目全非。使用这个功能就可以恢复IE的原面目
'在广州工作时，有一段时间这种事情特别的多。很多客户打电话，不胜其烦，就写了这个功能！
'这个功能现在很多软件都有了，我也不想再完善。列出来希望给大家带来一点思路
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoBrowserOptions", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoBrowserContextMenu", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoBrowserClose", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoBrowserSaveAs", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoFavorites", REG_DWORD, 0, 0

setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoFileNew", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoFileOpen", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoFindFiles", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoSelectDownloadDir", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Restrictions", "NoTheaterMode", REG_DWORD, 0, 0

setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Advanced", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Cache Internet", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "AutoConfig", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Wallet Wallet Proxy", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Messageing Languages", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Links", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "HomePage", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "History", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Fonts", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Connection Wizard", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Connection Settings", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "HColors", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Check_If_Default", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "Certificates", REG_DWORD, 0, 0
setvalue HKEY_CURRENT_USER, "Software\Policies\Microsoft\Internet Explorer\Control Panel", "CalendarContact", REG_DWORD, 0, 0
'恢复IE工具栏背景
setvalue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Toolbar", "BackBitmap", REG_SZ, "", 0
'恢复搜索引擎
setvalue HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer\Search", "SearchAssistant", REG_SZ, "http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchasst.htm", 0
setvalue HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer\Search", "CustomizeSearch", REG_SZ, "http://ie.search.msn.com/{SUB_RFC1766}/srchasst/srchasst.htm", 0
'恢复收藏夹的原始目录
setvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Favorites", REG_SZ, WinDir + "Favorites", 0
setvalue HKEY_CURRENT_USER, "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders", "Favorites", REG_SZ, WinDir + "Favorites", 0
setvalue HKEY_USERS, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Favorites", REG_SZ, WinDir + "Favorites", 0
setvalue HKEY_USERS, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders", "Favorites", REG_SZ, WinDir + "Favorites", 0

End Sub

Private Function MoveForm()
'调整窗口位置
'如果气泡窗口的高度小于frmGirl（卡通人）窗口到屏幕顶端的高度（换句话说就是在上面放得下）就显示向上的气泡窗口
If frmGirl.Top < Me.Height Then
With Me
BForm.Style = asbf_RightTop
.Top = frmGirl.Top + 20 * Screen.TwipsPerPixelX '+ MovForm.Height + 32 * Screen.TwipsPerPixelX
.Left = frmGirl.Left - Me.Width + 16 * Screen.TwipsPerPixelY
'.BForm.Top = .ScaleTop
'.BForm.Left = .ScaleLeft
.BForm.Width = .ScaleWidth
'.BForm.Height = .ScaleHeight
'气泡窗口的背景色
.BForm.BackColor = BForm_BackColor
'调整两个按钮的位置，窗口向上和向下时调整的方法不同
.PopCancel.BackColor = BForm.BackColor
.PopEnter.BackColor = BForm.BackColor
.PopEnter.Top = BForm.Top + BForm.Height - PopEnter.Height * 2 + 14 * Screen.TwipsPerPixelY
.PopCancel.Top = PopEnter.Top

End With
Else
'相反，显示向下的
With Me
BForm.Style = asbf_BottomRight
.Top = frmGirl.Top - .Height + 38 * Screen.TwipsPerPixelX
.Left = frmGirl.Left - .Width + 42 * Screen.TwipsPerPixelY
.BForm.Top = .ScaleTop
.BForm.Left = .ScaleLeft

'.BForm.Width = .ScaleWidth
'.BForm.Height = .ScaleHeight
.BForm.BackColor = BForm_BackColor
End With

End If

End Function