Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #Region Project Attributes
- #ApplicationLabel: B4A Example
- #VersionCode: 1
- #VersionName:
- 'SupportedOrientations possible values: unspecified, landscape or portrait.
- #SupportedOrientations: unspecified
- #CanInstallToExternalStorage: False
- #End Region
- #Region Activity Attributes
- #FullScreen: False
- #IncludeTitle: True
- #End Region
- Sub Process_Globals
- Type Point (X As Int, Y As Int)
- Type Node (X As Double, Y As Double, Z As Double)
- Type Face (Nodes As List, C As ColorDrawable)
- Type Obj (Nodes() As Node, Faces() As Face)
- Dim PI As Double = 3.14159
- End Sub
- Sub Globals
- Dim DCube As Obj = CreateCube(-100dip,-100dip,-100dip,200dip,200dip,200dip)
- Dim XOffset As Int = 200dip
- Dim YOffset As Int = 200dip
- Dim IsDown As Boolean
- Dim OldPoX As Int
- Dim OldPoY As Int
- Dim DragSensitivity As Int = 5
- End Sub
- Sub InitNode(X As Double, Y As Double, Z As Double) As Node
- Dim NewNode As Node
- NewNode.X = X
- NewNode.Y = Y
- NewNode.Z = Z
- Return NewNode
- End Sub
- Sub InitFace(Nodes As List, CLR As ColorDrawable) As Face
- Dim NewFace As Face
- NewFace.Nodes = Nodes
- NewFace.C = CLR
- Return NewFace
- End Sub
- Sub CreateCube(X As Double, Y As Double, Z As Double, W As Double, H As Double, D As Double) As Obj
- Dim Cube As Obj
- Dim Nodes(8) As Node
- Nodes(0) = InitNode(X,Y,Z)
- Nodes(1) = InitNode(X,Y,Z+D)
- Nodes(2) = InitNode(X,Y+H,Z)
- Nodes(3) = InitNode(X,Y+H,Z+D)
- Nodes(4) = InitNode(X+W,Y,Z)
- Nodes(5) = InitNode(X+W,Y,Z+D)
- Nodes(6) = InitNode(X+W,Y+H,Z)
- Nodes(7) = InitNode(X+W,Y+H,Z+D)
- Dim CLRs(6) As ColorDrawable
- For I=0 To CLRs.Length -1
- 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)))
- Next
- Dim Faces(6) As Face
- Faces(0) = InitFace(Array As Int(1, 3, 7, 5), CLRs(0))
- Faces(1) = InitFace(Array As Int(1, 0, 4, 5), CLRs(1))
- Faces(2) = InitFace(Array As Int(1, 3, 2, 0), CLRs(2))
- Faces(3) = InitFace(Array As Int(4, 6, 2, 0), CLRs(3))
- Faces(4) = InitFace(Array As Int(4, 6, 7, 5), CLRs(4))
- Faces(5) = InitFace(Array As Int(6, 7, 3, 2), CLRs(5))
- Cube.Nodes = Nodes
- Cube.Faces = Faces
- Return Cube
- End Sub
- Sub RotateX(Theta As Double, DObject As Obj)
- Dim Rad As Double = (2 * PI) * Theta / 360
- Dim TSin As Double = Sin(Rad)
- Dim TCos As Double = Cos(Rad)
- For N=0 To DObject.Nodes.Length - 1
- Dim Y As Double = DObject.Nodes(N).Y
- Dim Z As Double = DObject.Nodes(N).Z
- DObject.Nodes(N).Y = Y * TCos - Z * TSin
- DObject.Nodes(N).Z = Z * TCos + Y * TSin
- Next
- End Sub
- Sub RotateY(Theta As Double, DObject As Obj)
- Dim Rad As Double = (2 * PI) * Theta / 360
- Dim TSin As Double = Sin(Rad)
- Dim TCos As Double = Cos(Rad)
- For N=0 To DObject.Nodes.Length - 1
- Dim X As Double = DObject.Nodes(N).X
- Dim Z As Double = DObject.Nodes(N).Z
- DObject.Nodes(N).X = X * TCos - Z * TSin
- DObject.Nodes(N).Z = Z * TCos + X * TSin
- Next
- End Sub
- Sub RotateZ(Theta As Double, DObject As Obj)
- Dim Rad As Double = (2 * PI) * Theta / 360
- Dim TSin As Double = Sin(Rad)
- Dim TCos As Double = Cos(Rad)
- For N=0 To DObject.Nodes.Length - 1
- Dim X As Double = DObject.Nodes(N).X
- Dim Y As Double = DObject.Nodes(N).Y
- DObject.Nodes(N).Y = X * TCos - Y * TSin
- DObject.Nodes(N).Z = X * TSin + Y * TCos
- Next
- End Sub
- Sub DrawObject(DObj As Obj)
- Dim Canvas As Canvas
- Canvas.Initialize(Activity)
- Canvas.DrawColor(Colors.ARGB(255,0,0,0))
- For F=0 To DObj.Faces.Length - 1
- Dim NodeList As List = DObj.Faces(F).Nodes
- 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)
- 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)
- 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)
- 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)
- Next
- For N=0 To DObj.Nodes.Length - 1
- Dim Rect1 As Rect
- 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)
- Canvas.DrawOval(Rect1, Colors.blue, True, 5)
- 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")
- Next
- End Sub
- Sub UpdateDrawObject(DObj As Obj)
- Dim Canvas As Canvas
- Canvas.Initialize(Activity)
- Canvas.DrawColor(Colors.ARGB(255,0,0,0))
- For N=0 To DObj.Nodes.Length - 1
- Dim Rect1 As Rect
- 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)
- Canvas.DrawOval(Rect1, Colors.blue, True, 5)
- 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")
- Next
- Dim avgZ(DObj.Faces.Length) As Double
- Dim order(DObj.Faces.Length) As Int
- Dim tmp As Double
- Dim iMax As Int
- For i = 0 To DObj.Faces.Length - 1
- Dim NodeList As List = DObj.Faces(i).Nodes
- 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
- order(i) = i
- Next
- For i = 0 To DObj.Faces.Length - 1
- iMax = i
- For j = i + 1 To 5
- If avgZ(j) > avgZ(iMax) Then
- iMax = j
- End If
- Next
- If iMax <> i Then
- tmp = avgZ(i)
- avgZ(i) = avgZ(iMax)
- avgZ(iMax) = tmp
- tmp = order(i)
- order(i) = order(iMax)
- order(iMax) = tmp
- End If
- Next
- For F=0 To DObj.Faces.Length - 1
- Dim NodeList As List = DObj.Faces(order(F)).Nodes
- Dim CLR As ColorDrawable
- CLR = DObj.Faces(F).c
- Dim C As Canvas
- Dim P As Path
- Dim R As Rect
- C.Initialize(Activity)
- R.initialize(0, 0, Activity.Width, Activity.height)
- P.Initialize(XOffset + DObj.Nodes(NodeList.Get(0)).X,YOffset + DObj.Nodes(NodeList.Get(0)).y)
- P.LineTo(XOffset + DObj.Nodes(NodeList.Get(1)).X,YOffset + DObj.Nodes(NodeList.Get(1)).y)
- P.LineTo(XOffset + DObj.Nodes(NodeList.Get(2)).X,YOffset + DObj.Nodes(NodeList.Get(2)).y)
- P.LineTo(XOffset + DObj.Nodes(NodeList.Get(3)).X,YOffset + DObj.Nodes(NodeList.Get(3)).y)
- C.ClipPath(P)
- C.DrawDrawable(CLR,R)
- Next
- End Sub
- Sub Activity_Create(FirstTime As Boolean)
- Activity.LoadLayout("main")
- UpdateDrawObject(DCube)
- End Sub
- Sub Activity_Resume
- End Sub
- Sub Activity_Pause (UserClosed As Boolean)
- End Sub
- Sub Activity_Touch (Action As Int, X As Float, Y As Float)
- Select Action
- Case Activity.ACTION_DOWN
- IsDown = True
- OldPoX = X
- OldPoY = Y
- Case Activity.ACTION_MOVE
- If(IsDown = True) Then
- Dim NewPoX As Int = X - OldPoX
- Dim NewPoY As Int = Y - OldPoY
- RotateX(NewPoY / DragSensitivity, DCube)
- RotateY(NewPoX / DragSensitivity, DCube)
- OldPoX = X
- OldPoY = Y
- UpdateDrawObject(DCube)
- End If
- Case Activity.ACTION_UP
- IsDown = False
- End Select
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement