Advertisement
Guest User

New Basic4Android Shaded Cube

a guest
Apr 26th, 2015
319
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.74 KB | None | 0 0
  1. #Region Project Attributes
  2. #ApplicationLabel: B4A Example
  3. #VersionCode: 1
  4. #VersionName:
  5. 'SupportedOrientations possible values: unspecified, landscape or portrait.
  6. #SupportedOrientations: unspecified
  7. #CanInstallToExternalStorage: False
  8. #End Region
  9.  
  10. #Region Activity Attributes
  11. #FullScreen: False
  12. #IncludeTitle: True
  13. #End Region
  14.  
  15. Sub Process_Globals
  16. Type Point (X As Int, Y As Int)
  17. Type Node (X As Double, Y As Double, Z As Double)
  18. Type Face (Nodes As List, C As ColorDrawable)
  19. Type Obj (Nodes() As Node, Faces() As Face)
  20. Dim PI As Double = 3.14159
  21. End Sub
  22.  
  23. Sub Globals
  24. Dim DCube As Obj = CreateCube(-100dip,-100dip,-100dip,200dip,200dip,200dip)
  25. Dim XOffset As Int = 200dip
  26. Dim YOffset As Int = 200dip
  27.  
  28. Dim IsDown As Boolean
  29. Dim OldPoX As Int
  30. Dim OldPoY As Int
  31. Dim DragSensitivity As Int = 5
  32. End Sub
  33.  
  34. Sub InitNode(X As Double, Y As Double, Z As Double) As Node
  35.  
  36. Dim NewNode As Node
  37. NewNode.X = X
  38. NewNode.Y = Y
  39. NewNode.Z = Z
  40. Return NewNode
  41.  
  42. End Sub
  43.  
  44. Sub InitFace(Nodes As List, CLR As ColorDrawable) As Face
  45.  
  46. Dim NewFace As Face
  47. NewFace.Nodes = Nodes
  48. NewFace.C = CLR
  49. Return NewFace
  50.  
  51. End Sub
  52.  
  53. Sub CreateCube(X As Double, Y As Double, Z As Double, W As Double, H As Double, D As Double) As Obj
  54.  
  55. Dim Cube As Obj
  56.  
  57. Dim Nodes(8) As Node
  58. Nodes(0) = InitNode(X,Y,Z)
  59. Nodes(1) = InitNode(X,Y,Z+D)
  60. Nodes(2) = InitNode(X,Y+H,Z)
  61. Nodes(3) = InitNode(X,Y+H,Z+D)
  62. Nodes(4) = InitNode(X+W,Y,Z)
  63. Nodes(5) = InitNode(X+W,Y,Z+D)
  64. Nodes(6) = InitNode(X+W,Y+H,Z)
  65. Nodes(7) = InitNode(X+W,Y+H,Z+D)
  66.  
  67. Dim CLRs(6) As ColorDrawable
  68. For I=0 To CLRs.Length -1
  69. CLRs(I).Initialize(Colors.RGB(Rnd(0, 255), Rnd(0, 255), Rnd(0, 255)),Colors.RGB(Rnd(0, 255), Rnd(0, 255), Rnd(0, 255)))
  70. Next
  71.  
  72. Dim Faces(6) As Face
  73. Faces(0) = InitFace(Array As Int(1, 3, 7, 5), CLRs(0))
  74. Faces(1) = InitFace(Array As Int(1, 0, 4, 5), CLRs(1))
  75. Faces(2) = InitFace(Array As Int(1, 3, 2, 0), CLRs(2))
  76. Faces(3) = InitFace(Array As Int(4, 6, 2, 0), CLRs(3))
  77. Faces(4) = InitFace(Array As Int(4, 6, 7, 5), CLRs(4))
  78. Faces(5) = InitFace(Array As Int(6, 7, 3, 2), CLRs(5))
  79.  
  80. Cube.Nodes = Nodes
  81. Cube.Faces = Faces
  82.  
  83. Return Cube
  84.  
  85. End Sub
  86.  
  87. Sub RotateX(Theta As Double, DObject As Obj)
  88.  
  89. Dim Rad As Double = (2 * PI) * Theta / 360
  90.  
  91. Dim TSin As Double = Sin(Rad)
  92. Dim TCos As Double = Cos(Rad)
  93.  
  94. For N=0 To DObject.Nodes.Length - 1
  95.  
  96. Dim Y As Double = DObject.Nodes(N).Y
  97. Dim Z As Double = DObject.Nodes(N).Z
  98.  
  99. DObject.Nodes(N).Y = Y * TCos - Z * TSin
  100. DObject.Nodes(N).Z = Z * TCos + Y * TSin
  101.  
  102. Next
  103. End Sub
  104.  
  105. Sub RotateY(Theta As Double, DObject As Obj)
  106.  
  107. Dim Rad As Double = (2 * PI) * Theta / 360
  108.  
  109. Dim TSin As Double = Sin(Rad)
  110. Dim TCos As Double = Cos(Rad)
  111.  
  112. For N=0 To DObject.Nodes.Length - 1
  113.  
  114. Dim X As Double = DObject.Nodes(N).X
  115. Dim Z As Double = DObject.Nodes(N).Z
  116.  
  117. DObject.Nodes(N).X = X * TCos - Z * TSin
  118. DObject.Nodes(N).Z = Z * TCos + X * TSin
  119.  
  120. Next
  121. End Sub
  122.  
  123. Sub RotateZ(Theta As Double, DObject As Obj)
  124.  
  125. Dim Rad As Double = (2 * PI) * Theta / 360
  126.  
  127. Dim TSin As Double = Sin(Rad)
  128. Dim TCos As Double = Cos(Rad)
  129.  
  130. For N=0 To DObject.Nodes.Length - 1
  131.  
  132. Dim X As Double = DObject.Nodes(N).X
  133. Dim Y As Double = DObject.Nodes(N).Y
  134.  
  135. DObject.Nodes(N).Y = X * TCos - Y * TSin
  136. DObject.Nodes(N).Z = X * TSin + Y * TCos
  137.  
  138. Next
  139. End Sub
  140.  
  141. Sub DrawObject(DObj As Obj)
  142.  
  143. Dim Canvas As Canvas
  144. Canvas.Initialize(Activity)
  145.  
  146. Canvas.DrawColor(Colors.ARGB(255,0,0,0))
  147.  
  148. For F=0 To DObj.Faces.Length - 1
  149. Dim NodeList As List = DObj.Faces(F).Nodes
  150.  
  151. Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(0)).x,YOffset + DObj.Nodes(NodeList.Get(0)).Y,XOffset + DObj.Nodes(NodeList.Get(1)).X,YOffset + DObj.Nodes(NodeList.Get(1)).y, Colors.Red, 3)
  152. Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(1)).x,YOffset + DObj.Nodes(NodeList.Get(1)).Y,XOffset + DObj.Nodes(NodeList.Get(2)).X,YOffset + DObj.Nodes(NodeList.Get(2)).y, Colors.Red, 3)
  153. Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(2)).x,YOffset + DObj.Nodes(NodeList.Get(2)).Y,XOffset + DObj.Nodes(NodeList.Get(3)).X,YOffset + DObj.Nodes(NodeList.Get(3)).y, Colors.Red, 3)
  154. Canvas.DrawLine(XOffset + DObj.Nodes(NodeList.Get(3)).x,YOffset + DObj.Nodes(NodeList.Get(3)).Y,XOffset + DObj.Nodes(NodeList.Get(0)).X,YOffset + DObj.Nodes(NodeList.Get(0)).y, Colors.Red, 3)
  155. Next
  156.  
  157. For N=0 To DObj.Nodes.Length - 1
  158. Dim Rect1 As Rect
  159. Rect1.Initialize(XOffset + DObj.Nodes(N).X - 4, YOffset + DObj.Nodes(N).Y - 4, XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).Y + 4)
  160. Canvas.DrawOval(Rect1, Colors.blue, True, 5)
  161. Canvas.DrawText("N:" & (N + 1) & " (X:" & Round(DObj.Nodes(N).X) & " Y:"& Round(DObj.Nodes(N).y) & " Z:" & Round(DObj.Nodes(N).z) & ")", XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).y + 4, Typeface.DEFAULT, 10, Colors.white, "LEFT")
  162. Next
  163. End Sub
  164.  
  165. Sub UpdateDrawObject(DObj As Obj)
  166.  
  167. Dim Canvas As Canvas
  168. Canvas.Initialize(Activity)
  169.  
  170. Canvas.DrawColor(Colors.ARGB(255,0,0,0))
  171.  
  172. For N=0 To DObj.Nodes.Length - 1
  173. Dim Rect1 As Rect
  174. Rect1.Initialize(XOffset + DObj.Nodes(N).X - 4, YOffset + DObj.Nodes(N).Y - 4, XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).Y + 4)
  175. Canvas.DrawOval(Rect1, Colors.blue, True, 5)
  176. Canvas.DrawText("N:" & (N + 1) & " (X:" & Round(DObj.Nodes(N).X) & " Y:"& Round(DObj.Nodes(N).y) & " Z:" & Round(DObj.Nodes(N).z) & ")", XOffset + DObj.Nodes(N).X + 4, YOffset + DObj.Nodes(N).y + 4, Typeface.DEFAULT, 10, Colors.white, "LEFT")
  177. Next
  178.  
  179. Dim avgZ(DObj.Faces.Length) As Double
  180. Dim order(DObj.Faces.Length) As Int
  181. Dim tmp As Double
  182. Dim iMax As Int
  183.  
  184. For i = 0 To DObj.Faces.Length - 1
  185. Dim NodeList As List = DObj.Faces(i).Nodes
  186. avgZ(i) = DObj.Nodes(NodeList.Get(0)).Z + DObj.Nodes(NodeList.Get(1)).Z + DObj.Nodes(NodeList.Get(2)).Z + DObj.Nodes(NodeList.Get(3)).Z / 4.0
  187. order(i) = i
  188. Next
  189.  
  190. For i = 0 To DObj.Faces.Length - 1
  191. iMax = i
  192. For j = i + 1 To 5
  193. If avgZ(j) > avgZ(iMax) Then
  194. iMax = j
  195. End If
  196. Next
  197. If iMax <> i Then
  198. tmp = avgZ(i)
  199. avgZ(i) = avgZ(iMax)
  200. avgZ(iMax) = tmp
  201.  
  202. tmp = order(i)
  203. order(i) = order(iMax)
  204. order(iMax) = tmp
  205. End If
  206. Next
  207.  
  208. For F=0 To DObj.Faces.Length - 1
  209.  
  210. Dim NodeList As List = DObj.Faces(order(F)).Nodes
  211. Dim CLR As ColorDrawable
  212. CLR = DObj.Faces(F).c
  213. Dim C As Canvas
  214. Dim P As Path
  215. Dim R As Rect
  216. C.Initialize(Activity)
  217. R.initialize(0, 0, Activity.Width, Activity.height)
  218. P.Initialize(XOffset + DObj.Nodes(NodeList.Get(0)).X,YOffset + DObj.Nodes(NodeList.Get(0)).y)
  219. P.LineTo(XOffset + DObj.Nodes(NodeList.Get(1)).X,YOffset + DObj.Nodes(NodeList.Get(1)).y)
  220. P.LineTo(XOffset + DObj.Nodes(NodeList.Get(2)).X,YOffset + DObj.Nodes(NodeList.Get(2)).y)
  221. P.LineTo(XOffset + DObj.Nodes(NodeList.Get(3)).X,YOffset + DObj.Nodes(NodeList.Get(3)).y)
  222. C.ClipPath(P)
  223. C.DrawDrawable(CLR,R)
  224.  
  225. Next
  226. End Sub
  227.  
  228. Sub Activity_Create(FirstTime As Boolean)
  229. Activity.LoadLayout("main")
  230. UpdateDrawObject(DCube)
  231. End Sub
  232.  
  233. Sub Activity_Resume
  234.  
  235. End Sub
  236.  
  237. Sub Activity_Pause (UserClosed As Boolean)
  238.  
  239. End Sub
  240.  
  241. Sub Activity_Touch (Action As Int, X As Float, Y As Float)
  242. Select Action
  243. Case Activity.ACTION_DOWN
  244. IsDown = True
  245. OldPoX = X
  246. OldPoY = Y
  247. Case Activity.ACTION_MOVE
  248. If(IsDown = True) Then
  249. Dim NewPoX As Int = X - OldPoX
  250. Dim NewPoY As Int = Y - OldPoY
  251.  
  252. RotateX(NewPoY / DragSensitivity, DCube)
  253. RotateY(NewPoX / DragSensitivity, DCube)
  254.  
  255. OldPoX = X
  256. OldPoY = Y
  257.  
  258. UpdateDrawObject(DCube)
  259. End If
  260. Case Activity.ACTION_UP
  261. IsDown = False
  262. End Select
  263. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement