谁能帮我看一下这个鼠标。。。

yangff · 发表于 2008-6-19 05:51:14

加入我们，或者，欢迎回来。

您需要登录才可以下载或查看，没有帐号？注册会员

x

#==============================================================================
# ■ Mouse
#------------------------------------------------------------------------------
# 　不掉FPS的DLL鼠标。
#==============================================================================
class Mouse
# 定义变量
DLL = 'Mouse'
$GetActiveWindow = Win32API.new("user32", "GetActiveWindow", nil, 'l')
$hWnd = $GetActiveWindow.call
$Get_Pos_X = Win32API.new(DLL, 'Get_Pos_X', nil, 'l')
$Get_Pos_Y = Win32API.new(DLL, 'Get_Pos_Y', nil, 'l')
$Left = Win32API.new(DLL, 'Get_Left', nil, 'l')
$Right = Win32API.new(DLL, 'Get_Right', nil, 'l')
$Updata = Win32API.new(DLL, 'Updata_Mouse', nil, 'l')
$Mouse_Close = Win32API.new(DLL, 'Mouse_Close', nil, nil)
$Mouse_Start = Win32API.new(DLL, 'Mouse_Start', 'l', 'l')
#结束变量的定义
def init
$Mouse_Start.call($hWnd)
@x = 0
@y = 0
@left = false
@right = false
@cursor = Sprite.new
@cursor.bitmap = Cache.system("cursor1.png")
@cursor.z = 99999
end
def update
err = $Updata.call
if err != 0
raise "Up Mouse System Error..."
end
@x = $Get_Pos_X.call
@y = $Get_Pos_Y.call
@cursor.x = @x
@cursor.y = @y
l = $Left.call
r = $Right.call
if l == 1
@left = true
else
@left = false
end
if r == 1
@right = true
else
@right = false
end
end
def end
$Mouse_Close.call
end
def click_on(button)
if button = "L"
if @left
return true
end
end
if button = "R"
if @right
return true
end
end
end
def self.pos
return @x,@y
end
end
#==============================================================================
# ■ Graphics
#------------------------------------------------------------------------------
# 　图象模块，添加鼠标支持。
#==============================================================================
class << Graphics
alias origin_update update
def update
origin_update
$mouse.update
end
end
$mouse = Mouse.new
$mouse.init

复制代码

Dll是自制的哦~~
DLL：http://rpg.blue/upload_program/files/Mouse_94254616.rar
Dll是米有问题滴~~
能改就改吧。
dll代码

Private Type POINTAPI
x As Long
Y As Long
End Type
Dim p As POINTAPI
Dim l As Long
Dim hd As Long
Dim KeyTepy(1) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Function Get_Pos_X() As Long
If p.x < 0 Then
p.x = 0
End If
If p.x > 544 Then
p.x = 544
End If
Get_Pos_X = p.x
End Function
Private Function Get_Pos_Y() As Long
If p.Y < 0 Then
p.Y = 0
End If
If p.Y > 416 Then
p.Y = 416
End If
Get_Pos_Y = p.Y
End Function
Private Function Get_Left() As Integer
Get_Left = KeyTepy(0)
End Function
Private Function Get_Right() As Integer
Get_Right = KeyTepy(1)
End Function
Private Function Updata_Mouse() As Long
If Mouse_Open = True Then
Call GetCursorPos(p)
l = ScreenToClient(hd, p)
Dim x As Long
x = GetAsyncKeyState(1) '左键
'KeyTepy = 0
If x = -32767 Then
KeyTepy(0) = 1
Else
KeyTepy(0) = 0
End If
x = GetAsyncKeyState(2) '右键
If x = -32767 Then
KeyTepy(1) = 1
Else
KeyTepy(1) = 0
End If
Updata_Mouse = 0
Else
Updata_Mouse = 1
End If
End Function
Sub Mouse_Close()
ShowCursor (1)
l = ""
hd = ""
KeyTepy(0) = 0
KeyTepy(1) = 0
Mouse_Open = False
End Sub
Private Function Mouse_Start(hWnd As Long) As Long
ShowCursor (0)
hd = hWnd
Mouse_Open = True
Mouse_Start = 0
End Function
''''''''''''''''''''''''''''''''''''''''''''''''
'' DLL PROJECT ?004 DanSoft Australia ''
'' Your dlls MUST HAVE a DLLMain and Main ''
'' proc, otherwise it won't compile properly! ''
''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
'This is a dummy, so the IDE doesn't complain
'there is no Sub Main.
End Sub
Function DLLMain(ByVal hInstDLL As Long, ByVal fdwReason As Long, ByVal lpwReserved As Long) As Long
DLLMain = 1
End Function
'add more functions here, ie.
'Function addition(ByVal A As Double, ByVal B As Double) As Double
' addition = A + B
'End Function

复制代码

Dll的输出绝对符合标准！！！

link006007 · 发表于 2008-6-19 16:39:22

if button = "R" 这语句拿来干什么用?!{/gg}
其实默认的鼠标脚本是不会掉FPS的, 只是Win32API.call的次数太多
而且选择光标巨型的哪个函数是for循环... 选项越多帧数越低
对了, 默认的鼠标脚本每次call也都要对数组一次unpack和pack, 这样慢

yangff · 发表于 2008-6-19 18:50:49

以下引用link006007于2008-6-19 8:39:22的发言：

if button = "R" 这语句拿来干什么用?!
其实默认的鼠标脚本是不会掉FPS的, 只是Win32API.call的次数太多
而且选择光标巨型的哪个函数是for循环... 选项越多帧数越低
对了, 默认的鼠标脚本每次call也都要对数组一次unpack和pack, 这样慢

[本贴由作者于 2008-6-19 9:19:18 最后编辑]

调用 Clickon时告诉程序要传递的是左键还是右键

火鸡三毛老大 · 发表于 2008-6-19 19:46:23

能响应图片吗?

补：
一进去就错误
{/bz}

yangff · 发表于 2008-6-19 19:58:35

以下引用火鸡三毛老大于2008-6-19 11:46:23的发言：

能响应图片吗?

补：
一进去就错误

[本贴由作者于 2008-6-19 11:51:48 最后编辑]

就是啊，一进去就死机。
响应图片？
不打算写，主战上多了

zlink · 发表于 2008-6-19 22:37:49

if button = "R"
然道不是恒成立吗!? {/fd}

yangff · 发表于 2008-6-19 23:23:11

以下引用zlink于2008-6-19 14:37:49的发言：

if button = "R"
然道不是恒成立吗!?

.。。
vb些习惯了 {/fd}

但是，连初始化都不嫩嘎

link006007 · 发表于 2008-6-20 02:01:54

你的 Mouse_Start 函数存在bug
不懂VB 只能知道这么多了。。。。。。

yangff · 发表于 2008-6-20 02:04:06

以下引用link006007于2008-6-19 18:01:54的发言：

你的 Mouse_Start 函数存在bug
不懂VB 只能知道这么多了。。。。。。

没问题.
所有函数都无法调用哦 {/gg}

link006007 · 发表于 2008-6-20 02:08:21

= =
原来是这样。。。
那可能是VB编译出来的dll问题。。

帐号		自动登录	找回密码
密码			注册会员

谁能帮我看一下这个鼠标。。。

加入我们，或者，欢迎回来。

烫烫烫

开拓者

贵宾