VB开发安卓程序_游戏4控制物体行走

运行截图

代码来自 [Class] GamePad - Multitouch gamepad

本例程所需的库Gestures已上传

Main窗体代码如下：

#Region Module Attributes
	#FullScreen: False
	#IncludeTitle: True
	#ApplicationLabel: GamePad
	#VersionCode: 1
	#VersionName: 
	#SupportedOrientations: landscape
	#CanInstallToExternalStorage: False
#End Region

'Activity module
Sub Process_Globals
	Dim timer1 As Timer
End Sub

Sub Globals
	Dim gd As GamePad
	Dim movement As Float
	movement = 3dip
	Dim cvs As Canvas
	Dim lrect, rrect As Rect
End Sub

Sub Activity_Create(FirstTime As Boolean)
	If FirstTime Then
		timer1.Initialize("timer1", 10)
	End If
	gd.Initialize
	Dim length, rightPadding, leftPadding, bottomPadding As Int
	length = 100dip 'also the panel's height
	rightPadding = 70dip
	leftPadding = 20dip
	bottomPadding = 20dip
	gd.AddToActivity (Activity, leftPadding, 100%y - bottomPadding - length, _
		100%x - rightPadding - leftPadding, length)
		
	cvs.Initialize(Activity)
	lrect.Initialize(10dip, 10dip, 20dip, 20dip)
	rrect.Initialize(100%x - 20dip, 10dip, 100%x - 10dip, 20dip)
	cvs.DrawRect(lrect, Colors.Red, True, 0)
	cvs.DrawRect(rrect, Colors.Blue, True, 0)
End Sub

Sub Timer1_Tick
	HandleValue(lrect, gd.GetLeftValue, Colors.Red)
	HandleValue(rrect, gd.GetRightValue, Colors.Blue)
End Sub

Sub HandleValue(r As Rect, val As Int, color As Int)
	If val = gd.NONE Then Return
	cvs.DrawRect(r, Colors.Black, True, 0)
	Activity.Invalidate2(r)
	Select val
		Case gd.LEFT
			r.Left = r.Left - movement
			r.Right = r.Right - movement
		Case gd.RIGHT
			r.Left = r.Left + movement
			r.Right = r.Right + movement
		Case gd.UP
			r.Top = r.Top - movement
			r.Bottom = r.Bottom - movement
		Case gd.DOWN
			r.Top = r.Top + movement
			r.Bottom = r.Bottom + movement
	End Select
	cvs.DrawRect(r, color, True, 0)
	Activity.Invalidate2(r)
End Sub

Sub Activity_Resume
	timer1.Enabled = True
End Sub

Sub Activity_Pause (UserClosed As Boolean)
	timer1.Enabled = False
End Sub

类模块GamePad代码如下：

'version: 1.00

Sub Class_Globals

	Private ges As Gestures 'Gestures 是手势库，并不是B4A安装后带来的，需要到B4A官网下载
	Private pnl As Panel
	Private cvs As Canvas '画布对象
	
	Public NONE, LEFT, RIGHT, UP, DOWN 'NONE 没有的意思
	'上面这一句代码定义了4个变体型变量，这是Basic的一种比较特殊的变量
	'往里面放进什么类型的数据它就变成什么形的
	'Int、Long、 Double、 string可任意转换
	'以前只知道VB有这种类型,但从没试过B4A支不支持变体,毕竟B4A其实就是JAVA的壳
	'今天总算看到B4A也支持变体类型了
	
	NONE   = 0
	LEFT   = 1
	RIGHT = 2
	UP		  = 3
	DOWN = 4
	
	
	'开始：操纵杆 -------------------------------------------------------------------
	
	'自定义一个数据类型，并把这个数据库命名为操纵杆( joystick )'
	'因为这个游戏会有两个操纵杆来操作游戏中的两个方块
	Type joystick(x As Float, y As Float, zeroX As Float, zeroY As Float, color As Int)
	
	
	'定义两个操纵杆变量，一个是放在左边，另一个是放在右边的
	Dim jleft, jright As joystick 
	
	'结束：操纵杆 -------------------------------------------------------------------
	
	
	Private radius As Int 'radius 的意思就是半径、半径范围
	radius = 15dip

End Sub


Public Sub Initialize '初始化这个游戏走动 (GamePad) 类

	pnl.Initialize("")
	
	
	
	'开始：初始化手势类 -------------------------------------------------------------
	
	'初始化手势类变量,multitouch的意思是多点触碰
	'multiterminal n. 多端网路 adj. 多端的；多接头的
	'
	'关于监听可以参考下面我写的一篇文章
	'[原创]通过 Reflector 库实现手指拖动控件  
	'http://silentbees.blog.163.com/blog/static/228789031201311186436692/
	
	'监听面板控件 pnl  ，同时监听事件指向pnl_multitouch
	'	
	ges.SetOnTouchListener(pnl, "pnl_multitouch") 
	
	'结束：初始化手势类 -------------------------------------------------------------
	
	
	
	'开始：初始化两个操纵杆变量 ---------------------------------------------
	
	jleft.Initialize
	jleft.color = Colors.Red
	
	jright.Initialize
	jright.color = Colors.Blue
	
	'结束：初始化两个操纵杆变量 ---------------------------------------------
	
End Sub


Public Sub AddToActivity(act As Activity, vLeft As Int, vTop As Int, vWidth As Int, vHeight As Int) '把GamePad类加到将要操作的窗体中


	'开始：放置左右两个操纵杆 -------------------------------------------------------
	
	Dim iv1, iv2 As ImageView '定义两个图像浏览类变量，这个类是B4A安装后自带的
	
	iv1.Initialize("")
	iv2.Initialize("")
	
	'从目录资源载入操作盘图片
	iv1.Bitmap = LoadBitmap(File.DirAssets, "arrows.png")
	iv2.Bitmap = iv1.Bitmap
		
	'库 Core > 类 ImageView > 属性 Bitmap 
	'Bitmap As Bitmap  用于获得或设定分配给 ImageView 的位图. 
	'Example: 
	'ImageView1.Bitmap = LoadBitmap(File.DirAssets, "someimage.jpg")

	iv1.Gravity = Gravity .FILL 'FILL是填充的意思
	iv2.Gravity = Gravity.FILL
	
	'把几个可视控件加到	act 窗体中
	act.AddView(iv1, vLeft, vTop, vHeight, vHeight)
	act.AddView(iv2, vLeft + vWidth - vHeight, vTop, vHeight, vHeight)
	act.AddView(pnl, vLeft, vTop, vWidth, vHeight)
	
	cvs.Initialize(pnl)
	jleft.zeroX = pnl.Height / 2
	jleft.zeroY = pnl.Height / 2
	jright.zeroX = pnl.Width - pnl.Height / 2
	jright.zeroY = pnl.Height / 2
	
	MoveJoystick(jleft.zeroX, jleft.zeroY, jleft)
	MoveJoystick(jright.zeroX, jright.zeroY, jright)
	pnl.Invalidate
	
	'结束：放置左右两个操纵杆 -------------------------------------------------------
	

	
End Sub

Private Sub pnl_multitouch(View As Object, pointerID As Int, action As Int, x As Float, Y As Float) As Boolean
	Dim foundLeft, foundRight As Boolean
	For i = 0 To ges.GetPointerCount - 1
		If (action = ges.ACTION_UP OR action = ges.ACTION_POINTER_UP) AND _
			ges.GetPointerID(i) = pointerID Then
				Continue
		End If
		If ges.GetX(i) = -1 AND ges.GetY(i) = -1 Then Continue
		Dim gx, gy As Float
		gx = Max(0, Min(ges.GetX(i), pnl.Width))
		gy = Max(0, Min(ges.GetY(i), pnl.Height))
		If gx < pnl.Width / 2 Then
			gx = Min(gx, pnl.Height)
			foundLeft = True
			MoveJoystick(gx, gy, jleft)
		Else
			gx = Max(gx, pnl.Width - pnl.Height)
			foundRight = True
			MoveJoystick(gx, gy, jright)
		End If
	Next
	If Not(foundLeft) Then MoveJoystick(jleft.zeroX, jleft.zeroY, jleft)
	If Not(foundRight) Then MoveJoystick(jright.zeroX, jright.zeroY, jright)
	pnl.Invalidate
	Return True
End Sub

Private Sub MoveJoystick(x As Float, y As Float, j As joystick)
	cvs.DrawCircle(j.x, j.y, radius, Colors.Transparent, True, 0)
	Dim valuex, valuey As Float
	valuex = x - j.zeroX
	valuey = y - j.zeroY
	If Abs(valuex) > Abs(valuey) Then y = j.zeroY Else x = j.zeroX
	j.x = x
	j.y = y
	cvs.DrawCircle(j.x, j.y, radius, j.color, True, 0)
End Sub

Public Sub GetLeftValue As Int
	Return GetValue(jleft)
End Sub

Public Sub GetRightValue As Int
	Return GetValue(jright)
End Sub

Private Sub GetValue(j As joystick) As Int
	If Power(j.x - j.zeroX, 2) + Power(j.y - j.zeroY, 2) < Power(pnl.Height / 3, 2) Then
		Return NONE
	Else If j.x < j.zeroX Then 
		Return LEFT
	Else If j.x > j.zeroX Then
		Return RIGHT
	Else If j.y > j.zeroY Then
		Return DOWN
	Else If j.y < j.zeroY Then
		Return UP
	End If
End Sub