frmgirl.frm

传奇网吧伴侣源码

VERSION 5.00
Begin VB.Form frmGirl 
   Appearance      =   0  'Flat
   BackColor       =   &H00C0E0FF&
   BorderStyle     =   0  'None
   Caption         =   "华杰软件"
   ClientHeight    =   5910
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5640
   Icon            =   "frmGirl.frx":0000
   LinkTopic       =   "Form1"
   MousePointer    =   99  'Custom
   OLEDropMode     =   1  'Manual
   ScaleHeight     =   5910
   ScaleWidth      =   5640
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer4 
      Left            =   2160
      Top             =   1560
   End
   Begin VB.Timer Timer3 
      Left            =   1920
      Top             =   3240
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Left            =   600
      Top             =   3000
   End
   Begin VB.Timer Timer1 
      Left            =   720
      Top             =   1440
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   1560
      TabIndex        =   0
      Top             =   2040
      Width           =   1095
   End
End
Attribute VB_Name = "frmGirl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'卡通人的运动参数
'当前动作帧，共18帧
Dim GirlAction As Long
'当前动作，分"sit"（坐下）和"fly"（飞翔）
Dim GirlAct As String
Dim GCount As Long

'保存鼠标多久没有移动的计数器
Dim MouseCount As Long
'保存当前鼠标位置
Dim CurMousePoint As POINTAPI
'保存上一次移动时鼠标位置
Dim FristMousePoint As POINTAPI
'是否自动关机
Dim ShutDown As Long
'Dim IsMouseX, IsMouseY As Single
'Private r As Long
'Private entry As String
'配置文件路径
Private iniPath As String

Private Sub MakeFrom()
'将窗口的形状设为卡通人的形状
'首先读出卡通人
Dim i, Region1, Region2 As Long


'MsgBox MaxPolygonPoints

Region1 = CreateRectRgn(lpPoint(0).X, lpPoint(0).Y, lpPoint(1).X + 1, lpPoint(1).Y)
'Region1 = CreateRectRgn(1, 1, 100, 100)

For i = 2 To MaxPolygonPoints - 2 Step 2
Region2 = CreateRectRgn(lpPoint(i).X, lpPoint(i).Y, lpPoint(i + 1).X + 1, lpPoint(i + 1).Y)
'Debug.Print lpPoint(i).X, lpPoint(i).Y, lpPoint(i + 1).X + 1, lpPoint(i + 1).Y
CombineRgn Region1, Region1, Region2, RGN_OR
DeleteObject Region2
Next i


SetWindowRgn hwnd, Region1, True


End Sub

Private Sub Command1_Click()
Timer1.Interval = 250
Timer1.Enabled = True
End Sub




Private Sub Form_Load()
On Error GoTo ErrCode:
Dim lHwnd As Long
Dim Rc As RECT
Dim sClass As String * 255
Dim tmpLen As Long
Dim lCount As Long
Me.ScaleMode = 3
'Me.ScaleMode = 3


Me.Width = 64 * Screen.TwipsPerPixelX
Me.Height = 96 * Screen.TwipsPerPixelY
'MsgBox Screen.Width, , Screen.Height
'查找任务栏的位置
lHwnd = WindowFromPointXY(Screen.Width / Screen.TwipsPerPixelX - 1, Screen.Height / Screen.TwipsPerPixelY - 1)
tmpLen = GetClassName(lHwnd, sClass, 255)
Debug.Print lHwnd, sClass

'判断任务栏的高度
For lCount = 2 To 50



lHwnd = WindowFromPointXY(Screen.Width / Screen.TwipsPerPixelX - lCount, Screen.Height / Screen.TwipsPerPixelY - 10 + lCount / 2)
tmpLen = GetClassName(lHwnd, sClass, 255)
'Debug.Print Left(sClass, tmpLen)
If Left(sClass, tmpLen) = "TrayNotifyWnd" Then lCount = 60
Next lCount

GetWindowRect lHwnd, Rc

'MsgBox Rc.Right - Rc.Left, , Rc.Bottom - Rc.Top
'MsgBox Left(sClass, tmpLen)
If Rc.Left > 80 Then
Me.Move (Rc.Left - 80) * Screen.TwipsPerPixelX, (Rc.Top - 64) * Screen.TwipsPerPixelY
Else
'MsgBox (Screen.Width - 200) / Screen.TwipsPerPixelX, , (Screen.Height - 150) / Screen.TwipsPerPixelY
'如果找不到任务栏就默认为屏幕左下角
Me.Move Screen.Width - Screen.TwipsPerPixelX * 150, Screen.Height - Screen.TwipsPerPixelY * 86
End If

'.Top = Me.ScaleTop
'Form.Left = Me.ScaleLeft
'载入图片
Me.Picture = LoadResPicture(101, 0)



'设定初始动作为坐姿
GirlAct = "Sit"
GirlAction = 1

GCount = 1


     Me.Picture = LoadResPicture(101, 0)
     SetGirlSitPoint (1)
     MakeFrom

'人物运动时钟控制
Timer1.Interval = 200
Timer1.Enabled = True

'================================================================================
'设置Timer3，作为检测电脑是否空闲的计数器
  MouseCount = 0
  
  GetCursorPos FristMousePoint
  frmGirl.Timer3.Interval = 3000
  frmGirl.Timer3.Enabled = True
'iniPath$ = WinDir() + "system.ini"
'entry = GetFromINI("boot", "SCRNSAVE.EXE", iniPath)
'r = WritePrivateProfileString("boot", "SCRNSAVE.EXE", entry, iniPath)
'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run
'设置程序随系统启动
setvalue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "DesktopGirl", REG_SZ, App.Path + "\" + App.EXEName + ".exe", 0
'设置默认配置文件路径
iniPath$ = App.Path + "\SysSet.ini"
'读取是否自动关机
ShutDown = Val(GetFromINI("系统设置", "自动关机", iniPath))
'读取是否出现滚动广告条
tmpLen = Val(GetFromINI("系统设置", "滚动广告条", iniPath))
If tmpLen = 1 Then ADbar.Show
'使系统不出现屏幕保护，因为屏保会挡住待机画面。程序退出时会恢复！
SystemParametersInfo SPI_SETSCREENSAVEACTIVE, False, 0&, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE

Load frmTrayIcon                   '载入系统托盘模块
'MsgBox Form1.Height, , Screen.Height

Exit Sub

ErrCode:
MsgBox "传奇网吧伴侣无法正常启动，请重新下载或安装！" + Chr(13) + "传奇网吧伴侣目前支持win98/nt/2000，并需要VB运行库的支持！", , "启动出错"
Unload Me

End Sub




Private Sub form_Click()
 '    form.Picture = LoadResPicture(101, 0)
'     SetGirlSitPoint (1)
'     MakeFrom

'If GirlAct <> "Sit" Then
'GirlAct = "Sit"
'GirlAction = 1
'End If
'Debug.Print "Click"

'frmMessage.Show
End Sub

Private Sub form_DblClick()
'Unload frmTrayIcon
'Unload Me
'Unload frmBubble
'Unload frmMessage
'Unload frmADScreen
'Timer1.Enabled = True
'通过双击控制人物的运动或停止，这个功能主要是为了解决在玩游戏时，人物也"顽强"地出现在屏幕上，造成游戏不能正常！
If Timer1.Enabled = True Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If

End Sub



Private Sub form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'如果按下的是鼠标左键，则移动人物
If Button = 1 Then
  Unload frmMessage
  Unload frmBubble
  GirlAct = "Fly"
  GirlAction = 9
  ReleaseCapture
  SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
  'Load frmMessage
Else
'右键，则出现设置对话框
frmBubble.Show
     Me.Picture = LoadResPicture(101, 0)
     SetGirlSitPoint (1)
     MakeFrom

    If GirlAct <> "Sit" Then
    GirlAct = "Sit"
    GirlAction = 1
    End If
'Debug.Print "Click"

End If
'允许人物运动
Timer1.Enabled = True
End Sub



Private Sub form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

'If IsMouseX = x And IsMouseY = y Then
'Timer4.Interval = 1000
'Timer4.Enabled = True
'End If
'Debug.Print x, y
'If Timer1.Enabled Then
'Timer1.Enabled = False