设为首页收藏本站|繁體中文

Project1

 找回密码
 注册会员
搜索
查看: 1942|回复: 7
打印 上一主题 下一主题

VX RP鼠标模型

 关闭 [复制链接]

Lv2.观梦者

傻♂逼

梦石
0
星屑
374
在线时间
1606 小时
注册时间
2007-3-13
帖子
6562

烫烫烫开拓者

跳转到指定楼层
1
发表于 2008-2-20 22:55:17 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

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

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

x
实在做不下去了。干脆发出来。
VB程序开发的鼠标DLL参数合集:
  1. Private Type POINTAPI
  2. x As Long
  3. Y As Long
  4. End Type
  5. Dim p As POINTAPI
  6. Dim l As Long
  7. Dim hd As Long
  8. Dim KeyTepy As Integer
  9. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  10. Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  11. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  12. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  13. Private Function Get_Pos_X() As Long
  14. If p.x < 0 Then
  15.   p.x = 0
  16. End If
  17. If p.x > 544 Then
  18.   p.x = 544
  19. End If
  20. Get_Pos_X = p.x
  21. End Function
  22. Private Function Get_Pos_Y() As Long
  23. If p.Y < 0 Then
  24.   p.Y = 0
  25. End If
  26. If p.Y > 416 Then
  27.   p.Y = 416
  28. End If
  29. Get_Pos_Y = p.Y
  30. End Function
  31. Private Function Get_Left() As Integer
  32.   Get_Left = 0
  33.   If KeyTepy = 1 Then
  34.     Get_Left = 1
  35.   End If
  36. End Function
  37. Private Function Get_Right() As Integer
  38.   Get_Right = 0
  39.   If KeyTepy = 2 Then
  40.     Get_Right = 1
  41.   End If
  42. End Function
  43. Private Function Updata_Mouse() As Long
  44. If Mouse_Open = True Then
  45.    Call GetCursorPos(p)
  46.    l = ScreenToClient(hd, p)
  47.    Dim x     As Long
  48.    x = GetAsyncKeyState(1)       '左键
  49.    KeyTepy = 0
  50.    If x = -32767 Then
  51.      KeyTepy = 1
  52.    End If
  53.    
  54.    x = GetAsyncKeyState(2)       '右键
  55.    If x = -32767 Then
  56.      KeyTepy = 2
  57.    End If
  58.    Updata_Mouse = 0
  59. Else
  60.    Updata_Mouse = 1
  61. End If
  62. End Function
  63. Sub Mouse_Close()
  64.    ShowCursor (1)
  65.    l = ""
  66.    hd = ""
  67.    KeyTepy = ""
  68.     Mouse_Open = False
  69. End Sub
  70. Private Function Mouse_Start(hWnd As Long) As Long
  71.    ShowCursor (0)
  72.    hd = hWnd
  73.    Mouse_Open = True
  74.    Mouse_Start = 0
  75. End Function
复制代码
哎呀,蛋疼什么的最有爱了

Lv2.观梦者

傻♂逼

梦石
0
星屑
374
在线时间
1606 小时
注册时间
2007-3-13
帖子
6562

烫烫烫开拓者

2
 楼主| 发表于 2008-2-20 23:30:51 | 只看该作者
VB6
回复 支持 反对

使用道具 举报

Lv3.寻梦者

孤独守望

梦石
0
星屑
3137
在线时间
1535 小时
注册时间
2006-10-16
帖子
4321

开拓者贵宾

3
发表于 2008-2-20 23:30:54 | 只看该作者
一看就知道VB6.0,2003开始就不用type关键字而用structure了
菩提本非树,明镜本非台。回头自望路漫漫。不求姻缘,但求再见。
本来无一物,何处惹尘埃。风打浪吹雨不来。荒庭遍野,扶摇难接。
不知道多久更新一次的博客
回复 支持 反对

使用道具 举报

Lv2.观梦者

傻♂逼

梦石
0
星屑
374
在线时间
1606 小时
注册时间
2007-3-13
帖子
6562

烫烫烫开拓者

4
 楼主| 发表于 2008-2-20 23:32:22 | 只看该作者
2008:
Public Class Class1
    Public Structure POINTAPI
        Dim x As Integer
        Dim y As Integer
    End Structure
    Dim p As POINTAPI
    Dim l As Long
    Dim hd As Long
    Dim KeyTepy As Integer
    Dim Mouse_Open As Boolean
    Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByRef hwnd As Long, ByRef 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 = 0
        If KeyTepy = 1 Then
            Get_Left = 1
        End If
    End Function
    Private Function Get_Right() As Integer
        Get_Right = 0
        If KeyTepy = 2 Then
            Get_Right = 1
        End If
    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 = 1
            End If

            x = GetAsyncKeyState(2)       '右键
            If x = -32767 Then
                KeyTepy = 2
            End If
            Updata_Mouse = 0
        Else
            Updata_Mouse = 1
        End If
    End Function
    Sub Mouse_Close()
        ShowCursor(1)
        l = ""
        hd = ""
        KeyTepy = ""
        Mouse_Open = False
    End Sub
    Private Function Mouse_Start(ByVal hWnd As Long) As Long
        ShowCursor(0)
        hd = hWnd
        Mouse_Open = True
        Mouse_Start = 0
    End Function

End Class
哎呀,蛋疼什么的最有爱了
回复 支持 反对

使用道具 举报

Lv2.观梦者

傻♂逼

梦石
0
星屑
374
在线时间
1606 小时
注册时间
2007-3-13
帖子
6562

烫烫烫开拓者

5
 楼主| 发表于 2008-2-20 23:55:50 | 只看该作者
关键是生成后在RUBY以API调用,提示没有找不到该方法
哎呀,蛋疼什么的最有爱了
回复 支持 反对

使用道具 举报

Lv3.寻梦者 (暗夜天使)

名侦探小柯

梦石
0
星屑
3299
在线时间
3619 小时
注册时间
2006-9-6
帖子
37400

开拓者贵宾第3届短篇游戏大赛主流游戏组亚军第5届短篇游戏比赛亚军

6
发表于 2008-2-21 00:55:29 | 只看该作者
是VB的……?
那不是VX用的……
发VX区干嘛……
回复 支持 反对

使用道具 举报

头像被屏蔽

Lv1.梦旅人 (禁止发言)

梦石
0
星屑
50
在线时间
0 小时
注册时间
2008-2-11
帖子
154
7
发表于 2008-2-21 01:39:47 | 只看该作者
提示: 作者被禁止或删除 内容自动屏蔽
签名被屏蔽
回复 支持 反对

使用道具 举报

Lv2.观梦者

傻♂逼

梦石
0
星屑
374
在线时间
1606 小时
注册时间
2007-3-13
帖子
6562

烫烫烫开拓者

8
 楼主| 发表于 2008-2-21 02:04:58 | 只看该作者
以下引用越前リョーマ于2008-2-20 16:55:29的发言:
<br><script language="javascript">
<!--
strCont="是VB的……?\r\n那不是VX用的……\r\n发VX区干嘛……";
document.write(ubb.spbShowTopic(strCont,1));
//-->
</script>是VB的……?<br>
那不是VX用的……<br>
发VX区干嘛……

给VX调用的
#DLL位置
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')
但是会出错
哎呀,蛋疼什么的最有爱了
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册会员

本版积分规则

拿上你的纸笔,建造一个属于你的梦想世界,加入吧。
 注册会员
找回密码

站长信箱:[email protected]|手机版|小黑屋|无图版|Project1游戏制作

GMT+8, 2024-12-23 02:39

Powered by Discuz! X3.1

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表