VB 游戏制作

ikey 2003-06-03 05:37:20
哪位朋友对游戏(性质:代码公开,完全免费)制作方面有兴趣,请与小弟联系,共同学习。最好有美术基础。

VB 专业程序员不要跟贴。
过三个绿星不要跟贴。
...全文
483 49 打赏 收藏 转发到动态 举报
写回复
用AI写文章
49 条回复
切换为时间正序
请发表友善的回复…
发表回复
ikey 2003-06-09
  • 打赏
  • 举报
回复
'5部分,敌人的随机出现,代码未作整理,较乱,此代码配合敌人的类模块使用
'===============================================================
Option Explicit

Private IntW As Long
Private IntH As Long

Public Sub BasRndint(X As Long, Y As Long)
IntW = X
IntH = Y
End Sub


Public Sub RndInt(X1 As Long, Y1 As Long, M1 As Long, MP1 As Long)
'========================================
'X1 左上角 X 坐标
'Y1 左上角 Y 坐标
'M1 移动方向
' 3 Down
' 5 LeftDown
' 7 RightDown
'MP1 移动速度
'========================================
Dim ChooseInt As Long

X1 = Int(IntW * Rnd + 1)
Y1 = Int(IntH * Rnd + 1)
M1 = Int(7 * Rnd)

MP1 = Int(18 * Rnd + 1)

ChooseInt = Int(6 * Rnd + 1)

If ChooseInt <= 2 Then
X1 = 0
Else
Y1 = 0
End If

If X1 = 0 Then
M1 = 7
ElseIf Y1 > 0 And Y1 < 120 Then
If M1 <= 4 Then
M1 = 3
Else
M1 = 7
End If
ElseIf Y1 < IntW And Y1 > IntW - 120 Then
If M1 <= 4 Then
M1 = 3
Else
M1 = 5
End If
ElseIf M1 <= 3 Then
M1 = 3
ElseIf M1 > 3 And M1 <= 5 Then
M1 = 5
Else
M1 = 7
End If

End Sub
ikey 2003-06-09
  • 打赏
  • 举报
回复
'4部分,打印枪手,打印子弹的代码类似,不过要处理运动轨迹
'TrantBlt是自定义函数,可以去除图片中的黑色
'==============================================================
'打印枪手
If mLeft Then
TrantBlt GameMap.hdc, GameGunmanDC, _
0, 0, player1.sRight, player1.sBottom, player1.sLeft, player1.sTop
ElseIf mRight Then
TranBlt GameMap.hdc, GameGunmanDC, _
player1.sRight * 2, 0, player1.sRight, player1.sBottom, player1.sLeft, player1.sTop
Else
TranBlt GameMap.hdc, GameGunmanDC, _
player1.sRight, 0, player1.sRight, player1.sBottom, player1.sLeft, player1.sTop
End If

'==============================================================
二师兄的老公 2003-06-09
  • 打赏
  • 举报
回复
大开眼界!我顶!
ikey 2003-06-09
  • 打赏
  • 举报
回复
'3部分,背景填充滚动循环

'==============================================================
'打印地图
Dim intX As Integer
Dim intY As Integer

If LoopH < factMH Then
For intX = 0 To mapW + player1.sRight Step factMW 'down
For intY = LoopH To mapH + player1.sBottom Step factMH
BitBlt GameMap.hdc, intX, intY, factMW, factMH, GameBackDC, 0, 0, SRCCOPY
Next intY
Next intX

For intX = 0 To mapW + player1.sRight Step factMW 'up
For intY = 0 To LoopH Step factMH
BitBlt GameMap.hdc, intX, intY, factMW, factMH, GameBackDC, 0, factMH - LoopH, SRCCOPY
Next intY
Next intX
LoopH = LoopH + 1
Else
LoopH = 0
For intX = 0 To mapW + player1.sRight Step factMW
For intY = 0 To mapH + player1.sBottom Step factMH
BitBlt GameMap.hdc, intX, intY, factMW, factMH, GameBackDC, 0, 0, SRCCOPY
Next intY
Next intX
LoopH = LoopH + 1
End If

'==============================================================
zhengsuli 2003-06-09
  • 打赏
  • 举报
回复
study
zhengjianyi@msn.com
ikey 2003-06-09
  • 打赏
  • 举报
回复
'我只能连发三次
'===
'3部分,移动枪手
'枪手
Private player1 As track
Public Type track
Act As Boolean '是否处于活动
sLeft As Long '左距离(开始)
sTop As Long '上距离
sRight As Long '宽度
sBottom As Long '高度
sMove As fireway '移动方向
sMovePace As Long '移动速度

eLeft As Long '最大左距离(结束)
eTop As Long '最大上距离

eBlast As Boolean '爆炸
eSkin As Long '敌人皮肤
End Type
Private Sub MovePlayer()
'==============================================
'移动枪手

Select Case True
Case mLeft And mUp '左上
If player1.sLeft > 0 Then player1.sLeft = player1.sLeft - player1.sMovePace
If player1.sTop > 0 Then player1.sTop = player1.sTop - player1.sMovePace
player1.sMove = fLeftUp
Case mLeft And mDown '左下
If player1.sLeft > 0 Then player1.sLeft = player1.sLeft - player1.sMovePace
If mapH - player1.sTop > 0 Then player1.sTop = player1.sTop + player1.sMovePace
player1.sMove = fLeftDown
Case mRight And mUp '右上
If mapW - player1.sLeft > 0 Then player1.sLeft = player1.sLeft + player1.sMovePace
If player1.sTop > 0 Then player1.sTop = player1.sTop - player1.sMovePace
player1.sMove = fRightUp
Case mRight And mDown '右下
If mapW - player1.sLeft > 0 Then player1.sLeft = player1.sLeft + player1.sMovePace
If mapH - player1.sTop > 0 Then player1.sTop = player1.sTop + player1.sMovePace
player1.sMove = fRightDown
Case mLeft '左
If player1.sLeft > 0 Then player1.sLeft = player1.sLeft - player1.sMovePace
player1.sTop = player1.sTop
player1.sMove = fLeft
Case mDown '下
player1.sLeft = player1.sLeft
If mapH - player1.sTop > 0 Then player1.sTop = player1.sTop + player1.sMovePace
player1.sMove = fDown
Case mRight '右
If mapW - player1.sLeft > 0 Then player1.sLeft = player1.sLeft + player1.sMovePace
player1.sTop = player1.sTop
player1.sMove = fRight
Case mUp '上
player1.sLeft = player1.sLeft
If player1.sTop > 0 Then player1.sTop = player1.sTop - player1.sMovePace
player1.sMove = fUp
'==================================================

End Select

End Sub
ikey 2003-06-09
  • 打赏
  • 举报
回复
'2部分,键盘状态检测
'---------------
'用于获得虚拟键值状态
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Sub DoGames(GameMap As Form)
'==============================================

'获得键盘状态
mLeft = GetAsyncKeyState(vbKeyLeft)
mDown = GetAsyncKeyState(vbKeyDown)
mRight = GetAsyncKeyState(vbKeyRight)
mUp = GetAsyncKeyState(vbKeyUp)

Zz = GetAsyncKeyState(vbKeyZ)
Xx = GetAsyncKeyState(vbKeyX)
'其他利用GameMap的代码略
End Sub
ikey 2003-06-09
  • 打赏
  • 举报
回复
请大家不要留Email拉,现公布主要代码及其实现方法.
未使用DIRECTX. 分 15 部分
'1部分,循环
'---------------
'用于计时
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
'停止计时
Private ExitApp As Boolean
'暂停游戏
Private PauseZE As Boolean

Private Sub GetTime()
'开始计时
Dim NextTick As Long
Do Until ExitApp
DoEvents
Do Until GetTickCount > NextTick
DoEvents
Loop: NextTick = GetTickCount + 50
'暂停或继续
If PauseZE = False Then DoGames frmMain

Loop

End Sub
hohowu 2003-06-09
  • 打赏
  • 举报
回复
dut2000@yeah.net
谢谢。
拿棵草 2003-06-09
  • 打赏
  • 举报
回复
楼主真好!

不过,我现在正在学DIRECTX编程,不知哪位仁兄能提供给小弟一些这方面的编程资料呢?谢谢!
UP
apple_001 2003-06-09
  • 打赏
  • 举报
回复
applecut@163.com
我也要,不知道那位能给几个源代码看看
Kedsheng 2003-06-09
  • 打赏
  • 举报
回复
交个朋友!kedsheng@sohu.com
ikey 2003-06-09
  • 打赏
  • 举报
回复
pandengzhe(攀登者):有qq我给你传一个吧
pandengzhe 2003-06-09
  • 打赏
  • 举报
回复
搂住已经很不错了。
我正在学习用directx制作雪花、雨、闪电之类的效果,却找不到用窗口而不是全屏幕的例子。
不知道那里有啊??
ikey 2003-06-09
  • 打赏
  • 举报
回复
注:未收到Email的朋友真的很抱歉,因为代码加图形压缩后有4M多,我发起来真的好慢阿,希望还是在这里交流,以后的朋友就不要留Email了.
ikey 2003-06-09
  • 打赏
  • 举报
回复
以上只是敌人及其爆炸的部分代码,希望可以交流,有疑问的话,可以跟贴.
ikey 2003-06-09
  • 打赏
  • 举报
回复
看过,看过,很不错阿,好像很熟悉的拉.
其实我的和你的到是有很多相似的地方,只不过我把敌人封装成类而已.
所以大家还是下载你的就可以拉.

http://www.gameres.com/Production/2smallgame/
coolhealth 2003-06-09
  • 打赏
  • 举报
回复
我在

http://www.gameres.com/Production/2smallgame/

有两个公开源码的,大家看看。。。

ikey 2003-06-09
  • 打赏
  • 举报
回复
'补充5部分
'
'===================

'==============================================================
'随机的出现敌人

Dim EnDis As Integer
Dim DisE As Integer
DisE = Int(12 * Rnd)

Dim intLeft As Long, intTop As Long, intMove As Long, intMovePace As Long

For EnDis = 0 To eMax
If Enemy(EnDis).BlastDone = False And DisE < 2 Then
RndInt intLeft, intTop, intMove, intMovePace
Enemy(EnDis).setEnemyValue True, intLeft, intTop, intMove, intMovePace, mapW + player1.sRight, mapH + player1.sBottom, False, 1
End If
Next
'==============================================================
changdq 2003-06-07
  • 打赏
  • 举报
回复
共同进步,qingfeng0509@163.com
加载更多回复(29)

7,787

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧