1 Option Explicit
2 Private stack(100) As Object
3 Private transX As Integer
4 Private transY As Integer
5 Private transT As Double
6 Private addX As Integer
7 Private addY As Integer
8 Private addT As Double
9 Private index As Integer
10 Public genten2 As shape
11 Public currentName As String
12
13
14 Private Sub Class_Initialize()
15 index = -1
16 transX = 0
17 transY = 0
18 transT = 0
19 Set genten2 = ActiveSheet.Shapes("ローカル原点")
20 End Sub
21 Public Sub translate(x As Integer, y As Integer)
22 Dim mn() As Integer
23 mn = kaiten(0, 0, x, y, transT)
24 transX = transX + mn(0)
25 transY = transY + mn(1)
26 addX = x
27 addY = y
28 End Sub
29 Public Sub rotate(t As Double)
30 transT = transT + t
31 addT = t
32 End Sub
33 Public Sub rotateByKakudo(kakudo As Integer)
34 Call rotate(k2r(kakudo))
35 End Sub
36 Public Function gx(lx As Integer) As Integer
37 gx = transX + lx
38 End Function
39 Public Function gy(ly As Integer) As Integer
40 gy = transY + ly
41 End Function
42 Public Function gt(lt As Double) As Double
43 gt = transT + lt
44 End Function
45 Public Function gk(lk As Integer) As Integer
46 gk = r2k(transT) + lk
47 End Function
48 Public Sub save()
49 Dim obj As Object
50 Set obj = CreateObject("Scripting.Dictionary")
51 obj.Add "transX", transX
52 obj.Add "transY", transY
53 obj.Add "transT", transT
54 index = index + 1
55 Set stack(index) = obj
56 End Sub
57 Public Sub restore()
58 Dim obj As Object
59 Set obj = stack(index)
60 index = index - 1
61 transX = obj("transX")
62 transY = obj("transY")
63 transT = obj("transT")
64 End Sub
65 Public Sub shapeDraw(thisshape As shape, dx As Integer, dy As Integer)
66 Dim x As Integer: x = thisshape.Width / 2
67 Dim y As Integer: y = thisshape.Height / 2
68 Dim mn() As Integer
69 mn = kaiten(0, 0, dx + x, dy + y, transT)
70 thisshape.Left = gx(mn(0) - x)
71 thisshape.Top = gy(mn(1) - y)
72 thisshape.Rotation = r2k(transT)
73 If thisshape.name = currentName Then
74 Debug.Print thisshape.name
75 genten2.Left = transX - genten2.Width / 2
76 genten2.Top = transY - genten2.Height / 2
77 Debug.Print genten2.Left
78 Debug.Print genten2.Top
79 End If
80 End Sub
81 Function k2r(kakudo As Integer)
82 k2r = kakudo * (3.141592 / 180)
83 End Function
84 Function r2k(rad As Double)
85 r2k = rad * (180 / 3.14159)
86 End Function
87 Function kaiten(ByVal cx As Integer, ByVal cy As Integer, ByVal fromX As Integer, ByVal fromY As Integer, ByVal theta2 As Double) As Integer()
88 Dim res(1) As Integer, theta1 As Double, hankei As Integer
89 fromX = fromX - cx
90 fromY = fromY - cy
91 'check.
92 If fromX = 0 And fromY = 0 Then
93 res(0) = 0
94 res(1) = 0
95 kaiten = res
96 Exit Function
97 End If
98 theta1 = WorksheetFunction.Atan2(fromX, fromY)
99 Dim fromXL As Long: fromXL = fromX
100 Dim fromYL As Long: fromYL = fromY
101 hankei = Sqr(fromXL * fromXL + fromYL * fromYL)
102 res(0) = Cos(theta1 + theta2) * hankei + cx
103 res(1) = Sin(theta1 + theta2) * hankei + cy
104 kaiten = res
105 End Function