frmgirl.frm

传奇网吧伴侣源码

'Else
'Timer1.Enabled = True
'End If

'   ReleaseCapture
'    SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
Me.MouseIcon = LoadResPicture(101, 2)
Me.MousePointer = 99

End Sub



'====================================================================================================================================
'拖放保存网页地址
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
   If bAddress = 1 Then
    Effect = vbDropEffectCopy
    If Data.GetFormat(vbCFText) Then        '拖放的是网页地址
        strMessage = "这个网页地址是："
        strMessage = strMessage + Data.GetData(vbCFText) + Chr(10) + Chr(13) + "保存在c:\传奇精彩网址.txt中！"
        frmMessage.Show
        'MsgBox strMessage
        '保存网页到"c:\传奇精彩网址.txt"中
        Open "c:\传奇精彩网址.txt" For Append As #1
        Print #1, Data.GetData(vbCFText)
        Close #1
    End If
  End If
End Sub

Private Sub Form_Paint()
'====================================
'这一段是显示在前面，在设置状态下（其它窗口活动时），不激活；否则就一直激活它！
'If FindWindow(vbNullString, "frmBubble") <> 0 Or FindWindow(vbNullString, "==传奇软件==") <> 0 Then
'   Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE)
'Else
'  Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
'End If
 '  Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE)

End Sub

Private Sub Form_Unload(Cancel As Integer)
'恢复屏幕保护
SystemParametersInfo SPI_SETSCREENSAVEACTIVE, True, 0&, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE

End Sub

Private Sub Timer1_Timer()       '这个TIMER控件主要负责小可爱的活动和让她总是显示在最前面。
'Debug.Print FindWindow(vbNullString, "==传奇软件==") <> 0
'====================================
'这一段是显示在前面，在设置状态下（其它窗口活动时），不激活；否则就一直激活它！
'If FindWindow(vbNullString, "frmBubble") <> 0 Or FindWindow(vbNullString, "==传奇软件==") <> 0 Then
   Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE)
'Else
'   SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
  'Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)
'End If
'=====================================
'这一段是小可爱的活动！
Select Case GirlAct
Case "Sit"   '坐下
     If GirlAction < 9 Then
     Me.Picture = LoadResPicture(100 + GirlAction, 0)
     SetGirlSitPoint (GirlAction)
     MakeFrom
     GirlAction = GirlAction + 1
     'MsgBox GirlAction
     Else
     GirlAction = 1
     End If
Case "Fly"   '飞翔

     If GirlAction < 17 Then
     Me.Picture = LoadResPicture(100 + GirlAction, 0)
     SetGirlFlyPoint (GirlAction)
     MakeFrom
     GirlAction = GirlAction + 1
     'Me.Move Me.Left - 50, Me.Top - 50
     'MsgBox GirlAction
     Else
     GirlAction = 9
     End If
Case Else

End Select




End Sub

Private Sub Timer2_Timer()   '这个TIMER控件主要负责整点报时和重要提示！

'  bZDTime = Check1(0).Value
'  bZYTime = Check1(1).Value
'  sZYTimeString = Text1(0).Text
'  bQQ = Check1(2).Value
'  tZYTime = Format(Text1(1).Text, Date)
Dim nowTime As SYSTEMTIME
Dim strNowTime As String
Dim tNowHour As Long
Dim strNowWeek As String

If bZDTime = 1 Then
   Call GetSystemTime(nowTime)
   If nowTime.wMinute = 0 Then
   '以中文对话形式显示当前日期、时间
   
   strMessage = "现在是：" + Str(nowTime.wYear) + "年" + Str(nowTime.wMonth) + "月"
   If nowTime.wHour >= 16 Then
   strMessage = strMessage + Str(nowTime.wDay + 1) + "日，"
   nowTime.wDayOfWeek = nowTime.wDayOfWeek + 1
   Else
   strMessage = strMessage + Str(nowTime.wDay) + "日，"

   End If
   
   'If (nowTime.wHour + Time_Acer) > 12 Then
   'strMessage = strMessage + "下午" + Str((nowTime.wHour + Time_Acer) Mod 12) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + Str(nowTime.wDayOfWeek)
   'Else
   'strMessage = strMessage + "上午" + Str(nowTime.wHour) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + Str(nowTime.wDayOfWeek)
   'End If
   tNowHour = (nowTime.wHour + Time_Acer) Mod 24
  ' MsgBox tNowHour
   
   If nowTime.wDayOfWeek = 0 Then
   strNowWeek = "日"
   Else
   strNowWeek = Str(nowTime.wDayOfWeek)
   End If

   
   If tNowHour > 12 Then
      strNowTime = Str(tNowHour Mod 12) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + strNowWeek
   Else
      strNowTime = Str(tNowHour) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + strNowWeek
   End If
   '根据时间判断当前时间段，并显示不同文字
      
      If tNowHour > 23 Or tNowHour <= 6 Then
      strMessage = strMessage + "凌晨" + strNowTime + "。"
      Else
         If tNowHour > 6 And tNowHour <= 12 Then
         strMessage = strMessage + "上午" + strNowTime + "。"
         Else
              If tNowHour > 12 And tNowHour <= 18 Then
              strMessage = strMessage + "下午" + strNowTime + "。"
              Else
                  If tNowHour > 18 And tNowHour <= 21 Then
                  strMessage = strMessage + "晚上" + strNowTime + "。"
                  Else
                  '组成最终提示文字
                  strMessage = strMessage + "深夜" + strNowTime + "。"
                  End If
              End If
        
         End If
      End If

'MsgBox "aa", vbOKOnly, "bb"
   frmMessage.Show
   
   End If
End If
'重要事情提示
If bZYTime = 1 Then
   Call GetSystemTime(nowTime)
   If (nowTime.wHour + Time_Acer) Mod 24 = tZYTime.wHour And nowTime.wMinute = tZYTime.wMinute Then
      strMessage = "现在是：" + Str(nowTime.wYear) + "年" + Str(nowTime.wMonth) + "月"
   If nowTime.wHour >= 16 Then
   strMessage = strMessage + Str(nowTime.wDay + 1) + "日，"
   nowTime.wDayOfWeek = nowTime.wDayOfWeek + 1
   Else
   strMessage = strMessage + Str(nowTime.wDay) + "日，"

   End If
   
   'If (nowTime.wHour + Time_Acer) > 12 Then
   'strMessage = strMessage + "下午" + Str((nowTime.wHour + Time_Acer) Mod 12) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + Str(nowTime.wDayOfWeek)
   'Else
   'strMessage = strMessage + "上午" + Str(nowTime.wHour) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + Str(nowTime.wDayOfWeek)
   'End If
   tNowHour = (nowTime.wHour + Time_Acer) Mod 24
  ' MsgBox tNowHour
   '计算星期并以中文显示！
   If nowTime.wDayOfWeek = 0 Then
   strNowWeek = "日"
   Else
   strNowWeek = Str(nowTime.wDayOfWeek)
   End If

   '分析时间
   If tNowHour > 12 Then
      strNowTime = Str(tNowHour Mod 12) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + strNowWeek
   Else
      strNowTime = Str(tNowHour) + "点" + Str(nowTime.wMinute) + "分" + Str(nowTime.wSecond) + "秒，星期" + strNowWeek
   End If
      
      
      If tNowHour > 23 Or tNowHour <= 6 Then
      strMessage = strMessage + "凌晨" + strNowTime + "。"
      Else
         If tNowHour > 6 And tNowHour <= 12 Then
         strMessage = strMessage + "上午" + strNowTime + "。"
         Else
              If tNowHour > 12 And tNowHour <= 18 Then
              strMessage = strMessage + "下午" + strNowTime + "。"
              Else
                  If tNowHour > 18 And tNowHour <= 21 Then
                  strMessage = strMessage + "晚上" + strNowTime + "。"
                  Else
                  strMessage = strMessage + "深夜" + strNowTime + "。"
                  End If
              End If
        
         End If
      End If
'组成最终提示文字
   strMessage = strMessage + " " + sZYTimeString
   
   frmMessage.Show

   
   Else
   Debug.Print nowTime.wHour + Time_Acer, tZYTime.wHour
   End If
   
End If


End Sub

Private Sub Timer3_Timer()    '这个TIMER控件主要负责关闭QQ，广告和自动关机
Dim CurMousePoint As POINTAPI
MouseCount = MouseCount + 1
GetCursorPos CurMousePoint
'Debug.Print "find", FindWindow(vbNullString, "frmADScreen")
'如果鼠标移动则重新计数、关闭广告
If CurMousePoint.X <> FristMousePoint.X Or CurMousePoint.Y <> FristMousePoint.Y Then
MouseCount = 0
 If FindWindow(vbNullString, "frmADScreen") <> 0 Then
 Unload frmADScreen
 '出现设置对话框
 frmBubble.Show
 End If
 '保存鼠标位置
FristMousePoint.X = CurMousePoint.X
FristMousePoint.Y = CurMousePoint.Y
Else
   If MouseCount > 60 Then '关QQ
     If bQQ = 1 Then
     '此函数负责查找QQ窗口并关闭！
     Call FindAllApps(frmGirl)
     'MsgBox "mousecount"
     'MouseCount = 0
     End If
      
      If MouseCount > 100 And ShutDown = 1 Then '自动关机
      'MsgBox "12"
      '关闭系统
      ExitWindows "shutdown"
      End If

   Load frmADScreen '广告
   End If
End If

Debug.Print MouseCount


End Sub