批处理之家 - Powered by Discuz! Board

标题: [游戏娱乐] 【高清画质】批处理魔塔21层【更新1.1】 [打印本页]

作者: defanive 时间: 2012-11-18 10:57 标题: 【高清画质】批处理魔塔21层【更新1.1】

批处理魔塔21层
高清画质复刻
By Defanive (Neoix Team)

————————————————————————————————
本批处理使用了第三方工具CAPI注入版
http://www.bathome.net/thread-19238-1-1.html
————————————————————————————————

11/20/12：更新1.1
增加重新开始菜单项和快捷键R
增加CAPI运行检测
移除窗口默认菜单项
移除多余文件
修正游戏逻辑错误
修正对话框反应过快
修正音效在动作完成前播放

批处理下载：
[attach]5894[/attach]

高清画质复刻魔塔21层，同时有背景音乐和音效
所有素材取自网络，地图取自魔塔21层（胖老鼠工作室）
利用CAPI进行API调用，批处理首次实现了全彩画质的显示！
[attach]5893[/attach]
[attach]5891[/attach]

同时也对批处理窗口做了一些美化
去掉了win7下窗口默认的“管理员: ”前缀，把窗口图标改成了魔王，加入了游戏菜单项
[attach]5892[/attach]

作者: defanive 时间: 2012-11-18 10:59 标题: 关于第三方CAPI

本帖最后由 defanive 于 2012-11-18 11:39 编辑

本魔塔使用了第三方工具CAPI进行开发
CAPI提供了让批处理调用系统API的接口
由于可以非常自由的调用API，CAPI可以实现几乎所有其他第三方可以做到的功能

在本批处理中，通过调用user32.dll和gdi32.dll里面的API，实现了高清画质的显示、加菜单、居中窗口等
通过调用kernel32.dll中的API，实现了读取按键信息、隐藏光标、改批处理图标和标题
通过调用winmm.dll中的API，实现了背景音乐和音效的播放

系统API能实现的功能远不止这些，因此用CAPI可以给批处理带来无限潜力

作者: hotfoxgroup 时间: 2012-11-18 12:32

厉害，厉害！我什么时候能到开发CAPI这种水平？遥遥无期！
赞

作者: ipqfhvk 时间: 2012-11-18 13:41

赞一个，灰常好

作者: tmplinshi 时间: 2012-11-18 14:22

玩到了 21 层，提示“无法战胜”。按“J”也无法返回..

作者: defanive 时间: 2012-11-18 14:29

回复 5# tmplinshi
因为你真的没办法战胜
他的属性是血45000攻2550防2250（按L可以看到）
至于J没办法跳下去，这个是原版游戏的设定
BOSS战总不能逃跑吧哈哈
PS 有按S存档么，有的话A读档就好了

作者: tmplinshi 时间: 2012-11-18 14:34

回复 6# defanive

哦...

有存档。

那只能重新开始了？没耐性了，好不容易到了 21 层...

作者: tmplinshi 时间: 2012-11-18 14:44

作者: defanive 时间: 2012-11-18 14:53

回复 8# tmplinshi
其实可以改存档哦，存档第一行里面全部都是玩家数据
改源码的话正解了哈哈

作者: batman 时间: 2012-11-19 13:22

玩个屁游戏还改源码做弊，真有你的，tmplinshi。。。

作者: Heykuz 时间: 2012-11-19 15:10

同意楼上的。真男人该自己研究过关，改源码，我也鄙视。

作者: cutebe 时间: 2012-11-19 15:41

本帖最后由 cutebe 于 2012-11-19 16:23 编辑

标题显示 Loading...
内容显示两行找不到操作数

(%Function_InitText%)　%执行这句前不会，执行后就出现错误提示%

玩不了，我好可怜

作者: defanive 时间: 2012-11-20 04:58

回复 12# cutebe
注入失败了
试一下关掉杀软，或者把capi.exe和dll设为信任

作者: cutebe 时间: 2012-11-20 15:02

设为信任还是会
彻底关掉杀软也不行

看来我的系统（XP）是有大问题了。

作者: cutebe 时间: 2012-11-21 13:47

BUG 当金币和经验超过100时，红钥匙的红字会只有一半，且数量看不到。
当就是图 _ui 会把靠窗口右边的文字挡住。

如 5 楼、8 楼图

作者: tmplinshi 时间: 2012-11-21 14:05

本帖最后由 tmplinshi 于 2012-11-21 14:07 编辑

11/20/12：更新1.1
增加重新开始菜单项和快捷键R
增加CAPI运行检测
移除窗口默认菜单项
移除多余文件
修正游戏逻辑错误
修正对话框反应过快
修正音效在动作完成前播放 ...
defanive 发表于 2012-11-18 10:57

可以穿墙

作者: Demon 时间: 2012-11-21 18:57

膜拜一下。

作者: defanive 时间: 2012-11-22 03:33

回复 16# tmplinshi
我擦…测试时候开挂发布忘记修回去了…

作者: 0123456789 时间: 2012-11-24 10:28

表示神秘源码看不懂。

作者: defanive 时间: 2012-11-25 11:27

11/24/12
修正了穿墙的BUG
修正了一些音效遗漏

作者: 522235677 时间: 2012-11-25 17:51

哇哦，老牛逼了

作者: sl543001 时间: 2012-12-2 12:31

继续强力支持一下~

作者: tkaven 时间: 2013-1-28 22:05

支持下，表示玩到 21 层打不过改 SaveData.txt 过了 = = 囧

作者: tkaven 时间: 2013-1-28 22:08

还有我对 win32 API 的有些 API 的语法不太熟悉有空请教你。。。。。话说能否用这个做个托盘体跑提示呢？哈哈应该没问题的吧估计不需要多少行代码，有空的话帮我留意一下我只知道基本的要用到 "shell32" "LoadImageA" 这两个API

作者: tkaven 时间: 2013-1-28 22:10

能否把下面这个 VB 源码翻译成 cmd 脚本版的呢？期待话说好久没来这论坛逛了呢，哈哈~

作者: tkaven 时间: 2013-1-28 22:10

VERSION 5.00
Begin VB.Form TipBall
Appearance    = 0  'Flat
BackColor    = &H80000005&
BorderStyle    = 0  'None
Caption       = "气泡"
ClientHeight = 3600
ClientLeft    = 0
ClientTop    = 0
ClientWidth    = 4800
ClipControls = 0 'False
ControlBox    = 0 'False
Enabled       = 0 'False
FillColor    = &H80000005&
FillStyle    = 0  'Solid
FontTransparent = 0 'False
ForeColor    = &H80000005&
HasDC          = 0 'False
Icon          = "气泡主体.frx":0000
LinkTopic    = "Form1"
MaxButton    = 0 'False
MinButton    = 0 'False
Moveable       = 0 'False
NegotiateMenus  = 0 'False
ScaleHeight    = 3600
ScaleMode    = 0  'User
ScaleWidth    = 4800
ShowInTaskbar = 0 'False
Visible       = 0 'False
End
Attribute VB_Name = "TipBall"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

'托盘API 模块
Private M_IconData As NOTIFYICONDATA
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 128
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

'使用高分辨率图标所用的API
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long

Private Declare Function timeGetTime Lib "winmm.dll" () As Long '延迟API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '避免延迟时CPU使用率过高 Sleep API

Dim CountStrC As Integer
  '统计参数个数

Dim Strcmd '参数拆分后的数组

Dim Info, TitleAndKind, Title, TipKinds, Start_Pro As String
'内容标题与提示种类  标题  提示种类点击运行

Dim Hide_Start As Boolean '是否隐藏启动点击运行

Dim TrayIcon '用于存高分辨率图标

Dim SleepT '延迟时间
Dim Begintime As Double '记录当前时间

Private Sub Form_Load()
Me.Hide '无窗口
On Error GoTo EndPor '防止拖拽(如果参数类型不对则结束程序)

If InStr(Command, ";;") <> "0" Then '如果参数不为空则

      Strcmd = Split(Command, ";;") '拆分所有参数

      CountStrC = UBound(Strcmd) - LBound(Strcmd) + 1 '获取参数数目

         Dim Tmp As String, i '自定义延迟时获取延迟时间
         For i = 1 To Len(Strcmd(0)) '只获取数字
            Tmp = Mid(Strcmd(0), i, 1)
            If Asc(Tmp) <= Asc("9") And Asc(Tmp) >= Asc("0") Then SleepT = SleepT & Tmp
         Next

            If CountStrC >= "2" Then  '如果有标题则

                  If Strcmd(1) <> "" Then '如果标题不为空则
                     If InStr(Strcmd(1), "#@") <> "0" Then '如果指定了标题类型则
                        TitleAndKind = Split(Strcmd(1), "#@") '拆分标题与标题类型参数并存入数组
                        Title = TitleAndKind(0) '获取标题

                        '设定提示类型
                        If TitleAndKind(1) = "0" Then
                              TipKinds = &H0 '无标题图标
                        Else
                              If TitleAndKind(1) = "1" Then
                                 TipKinds = &H7 '询问标题图标
                              Else
                                 If TitleAndKind(1) = "2" Then
                                    TipKinds = &H2 '感叹标题图标
                                 Else
                                    If TitleAndKind(1) = "3" Then
                                          TipKinds = &H3 '错误标题图标
                                    Else
                                          If TitleAndKind(1) = "4" And CountStrC >= "5" Then If Trim(Strcmd(4)) <> "" Then TipKinds = &H4 '当设定了托盘图标与4时，设定标题图标同托盘图标
                                    End If
                                 End If
                              End If
                        End If

                     Else
                        Title = Strcmd(1) '没指定类型时直接获取标题
                     End If
                  Else '如果标题为空则
                     TipKinds = &H0 '无提示类型
                  End If

                  If CountStrC >= "3" Then

                     Info = Replace((Strcmd(2)), "\n", vbCrLf)  '获取内容并转义"\n"回车符

                     If CountStrC >= "4" Then '如果有点击后运行的命令
                        If InStr(Strcmd(3), "##") <> "0" Or InStr(Strcmd(3), "##") <> "0" Then '如果指定为隐藏运行获取命令路径并删除 ##
                              Start_Pro = Replace(Strcmd(3), "##", "")
                              Hide_Start = True
                        Else
                              Start_Pro = Trim(Strcmd(3)) '否则直接获取点击后运行的命令
                        End If

                        If CountStrC >= "5" Then
                              TrayIcon = LoadImage(App.hInstance, Trim(Strcmd(4)), 1, 16, 16, &H10 Or &H1000) '先检测图标文件是否存在如存在自定义托盘图标
                              If Trim(Strcmd(4)) <> "" Then If TrayIcon = "0" Then GoTo TrayIcoHelp '如果托盘ICO 文件类型不对则提示错误
                        End If

                     End If

                  End If

                  If Info = "" Then '如果内容为空则提示错误
                     Info = "提示内容应不为空"
                     Show_Error '调用错误处理
                  End If

            End If

Else '如果参数里不含分号则
      If Command = "" Then '如果参数为空则显示参数格式
         Title = "气泡调用参数　"
         Info = "[时间];;[标题[#@标题图标]];;内容;;" & vbCrLf & "[点击后执行的命令[##]];;[托盘图标路径]" & vbCrLf & vbCrLf & "正键点击我查看参数详细说明"
         SleepT = 20000
      Else '如果有参数但参数没包含分号
         Info = "请键入参数分隔符" & vbCrLf & "参数分隔符为两个西文半角的分号"
         Show_Error '调用错误处理
      End If
End If

Begintime = timeGetTime '记下开始时的时间
While timeGetTime < Begintime + 2600  '循环等待原托盘退出
      Por_Num = 0 '初始化进程数值
      Call EnumWindows(AddressOf EnumWindowsProc, 0) ' 检测是否有新的调用
      If Por_Num < 2 Then Tip_Show '调用气泡
      Sleep 3 '避免延迟时CPU使用率过高
      DoEvents '转让控制权，以便让操作系统处理其它的事件。
Wend

'################## 以下为错误处理 #####################

EndPor: End '防止拖拽 (注意这行不可改变位置与删除,须接在循环等待后面)

TrayIcoHelp: Info = "自定义托盘图标参数错误" & vbCrLf & "所指定的不是 .Ico文件"
            Show_Error '调用错误处理

'################## 以上为错误处理 #####################

End Sub

Private Sub Show_Error() '错误处理
      '初始化错误参数
      Title = "参数错误！"
      TipKinds = &H3
      SleepT = 0
      Start_Pro = ""
      Tip_Show '调用气泡显示错误信息
End Sub

Private Sub Tip_Show()
With M_IconData
      .cbSize = Len(M_IconData)
      .hwnd = Me.hwnd
      .uID = vbNull
      .uFlags = &H2 Or &H10 Or &H1 Or &H4 '设定托盘图标、提示图标、信息栏
      .uCallbackMessage = &H200
      .hIcon = TrayIcon '托盘图标
      .szTip = "气泡提示" & vbNullChar
      .dwState = 0
      .dwStateMask = 0
      If SleepT = 0 Then SleepT = 7000 '有参数时的默认延迟
      .uTimeout = SleepT
      .szInfo = Info + Chr(0)  '内容
      .szInfoTitle = Title + Chr(0) '标题
      If TipKinds = "" Then TipKinds = &H1 '当标题图标为空时设定标题图标为普通标题图标
      .dwInfoFlags = TipKinds '提示类型
End With
Shell_NotifyIcon &H0, M_IconData '创建托盘图标

'调用延迟
Begintime = timeGetTime '记下开始时的时间
      While timeGetTime < Begintime + SleepT '循环等待
         Por_Num = 0 '初始化进程数值
         Call EnumWindows(AddressOf EnumWindowsProc, 0) ' 检测是否有新的调用
         If Por_Num >= 2 Then Tip_Exit '调用退出
         Sleep 2 '避免延迟时CPU使用率过高
         DoEvents '转让控制权，以便让操作系统处理其它的事件。
      Wend
Tip_Exit '调用退出
End Sub

Private Sub Tip_Exit()
Shell_NotifyIcon &H2, M_IconData '删除托盘图标
End '退出程序
End Sub

'鼠标事件
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim cEvent As Single
cEvent = x / Screen.TwipsPerPixelX
Select Case cEvent
      Case 512
         'Debug.Print "MouseMove"
      Case 1026
         'Debug.Print "气泡显示"
      Case 1028 '右键点击或关闭气泡
         Tip_Exit '调用退出
      Case 1029 '左键或中键点击气泡
         If Title = "气泡调用参数　" Then
            Dim TxtHelp As String
            TxtHelp = vbCrLf & vbCrLf
            TxtHelp = TxtHelp & "参数格式:" & vbCrLf & "[ShowsTime];;[Title[#@TitleIcoType]];;Text;;[ClickRun_FilePath[##]];;[TrayIco_FilePath]" & vbCrLf & vbCrLf
            TxtHelp = TxtHelp & "ShowsTime       气泡显示时间单位Ms" & vbCrLf
            TxtHelp = TxtHelp & "Text             内容(支持 \n 回车转义符)" & vbCrLf
            TxtHelp = TxtHelp & "Title          标题" & vbCrLf
            TxtHelp = TxtHelp & "TitleIcoType    标题图标类型　0:无图标、1:询问图标、2:感叹图标、3:错误图标、4:同托盘图标" & vbCrLf
            TxtHelp = TxtHelp & "ClickRun_FilePath 鼠标正键点击气泡后运行的外部程序" & vbCrLf
            TxtHelp = TxtHelp & "##             无窗口运行点击气泡后的外部程序" & vbCrLf
            TxtHelp = TxtHelp & "TrayIco_FilePath  自定义托盘图标文件路径　(支持XP样式的 .Ico图标!)" & vbCrLf & vbCrLf
            TxtHelp = TxtHelp & "注: ""[ ]""    中为可选参数、参数分隔符为两个西文半角的分号" & vbCrLf & vbCrLf & vbCrLf
            TxtHelp = TxtHelp & "各项参数的缺省值: 标题图标为提示图标、显示7000ms、无托盘图标、无点击气泡后执行的命令" & vbCrLf & vbCrLf & vbCrLf
            TxtHelp = TxtHelp & "调用举例:" & vbCrLf
            TxtHelp = TxtHelp & """程序路径""  9000;;凌枫工作组#@2;;By T_kaven\nQQ群:35962310\n\n点击我打开记事本;;%Windir%\Notepad.exe"
            MsgBox TxtHelp, 65536, "参数详细说明 (点击确定后本帮助会自动复制到剪切板)"
            Clipboard.Clear '清除剪贴板
            Clipboard.SetText TxtHelp '将帮助文本传送到剪贴板
            Info = "By T_kaven" & vbCrLf & "QQ群:35962310" & vbCrLf & vbCrLf & "点击我打开记事本"
            Title = "凌枫工作组"
            SleepT = 9000
            TipKinds = &H2 '感叹提示
            Start_Pro = Environ$("windir") & "\Notepad.exe"
            Shell_NotifyIcon &H2, M_IconData '删除托盘图标
            Tip_Show '调用气泡
         Else
            If Start_Pro <> "" Then '如果有点击后的命令则
                  On Error Resume Next '如果找不到文件则忽略(不检测文件是否存在用于支持带参数运行)
                  If Hide_Start = True Then
                     Shell (Start_Pro), vbHide '如果 Hide_Start = True 隐藏运行
                  Else
                     Shell (Start_Pro), vbNormalFocus '否则正常运行
                  End If
            End If
         End If
         Tip_Exit '调用退出
End Select
End Sub

作者: defanive 时间: 2013-1-31 08:40

回复 26# tkaven
CAPI的语法挺简单的，结构体的处理的话，开一片内存往里面写数据就好了

作者: xxzpc 时间: 2013-4-12 16:13

好强大，学习了，游戏也好玩...

作者: 狱渊 时间: 2013-4-28 19:47

回复 1# defanive

可惜啊我的打不开

作者: kklll 时间: 2013-5-27 17:57

好家伙，很好很好

作者: dengyuli 时间: 2013-8-8 13:47

我把游戏改编了一下，目前已经编到了25层
这是第22层：

作者: 9zhmke 时间: 2013-8-17 17:58

先膜拜一下......但还是有点担心批处理的效率，批处理的强项在于便捷而不在于大型程序，能开发出这种东西已经很强大了，但总觉得有点偏，可以用B、C、JAVA一类的程序来做这种吧，对于更智化一些的游戏或程序来说，恐怕您的程序要实现起来也有难度了。

作者: cjw00529017 时间: 2013-9-9 14:24

挺好玩的呢真不错佩服晚了一中午打到17层过不去了

作者: defanive 时间: 2013-10-1 14:38

回复 32# 9zhmke
当然的，批处理本身就不是为了做这种大程序设计的
这个程序只有两个目的，一个是推广CAPI，另外一个是挑战批处理的极限

作者: COPYFREE 时间: 2013-12-11 15:21

运行不了，不过看了图片觉得还是很震撼的，牛

作者: 狱渊 时间: 2013-12-14 15:39

很好！我完全不懂cmd
了

作者: 0000 时间: 2017-6-16 23:07

本帖最后由 0000 于 2017-6-16 23:08 编辑

来自win10用户的无奈
capi一调用图闪一下就没了

作者: zhangzsky 时间: 2019-1-21 12:57

本帖最后由 zhangzsky 于 2020-3-7 07:35 编辑

回复 37# 0000
MotaHD(Repaired by ZhangZsky).7z

作者: sds 时间: 2022-12-5 17:43

没有Win764位的版本吗? 我这里打不开，设为信任也没用。

作者: sds 时间: 2022-12-5 17:46

回复 37# 0000 我比你更无奈，不是闪不闪烁的问题了，直接打不开!我Win7 64位

作者: sds 时间: 2022-12-5 18:00

回复 14# cutebe 我也是，看来我这Windows 7（64位)不能要了

欢迎光临批处理之家 (http://bbs.bathome.net/)