このファイル: /home/web6047/www/cgi-bin/prj/20180511-svc_edit/_preview/Sheet1.txt
1
Option Explicit
2
3
Public svcs As Object
4
Public topsvc As svc
5
6
'セル定義
7
Const spinButtonTop As String = "g7"
8
Const spinButtonTop2 As String = "h7"
9
Const firstLine As String = "a12"
10
Const propbase As String = "b11"
11
12
Public canvasX As Integer
13
Public canvasY As Integer
14
15
Dim l As LocalAxis
16
17
Sub 更新_Click()
18
Call updateGentens
19
Call initSvcs
20
Call draw
21
End Sub
22
23
24
Public Sub SpinButton1_SpinUp()
25
26
Call initSvcs
27
28
'値変更
29
Dim targetName As String: targetName = Range(firstLine).Offset(Range(spinButtonTop).Value - 1, 0).Value
30
Dim propName As String: propName = Range(propbase).Offset(0, Range(spinButtonTop2).Value - 1).Value
31
32
Dim thissvc As svc: Set thissvc = svcs(targetName)
33
thissvc.cells(propName).Value = thissvc.cells(propName).Value + 1
34
35
Call draw
36
37
End Sub
38
Public Sub SpinButton1_SpinDown()
39
40
Call initSvcs
41
42
'値変更
43
Dim targetName As String: targetName = Range(firstLine).Offset(Range(spinButtonTop).Value - 1, 0).Value
44
Dim propName As String: propName = Range(propbase).Offset(0, Range(spinButtonTop2).Value - 1).Value
45
46
Dim thissvc As svc: Set thissvc = svcs(targetName)
47
thissvc.cells(propName).Value = thissvc.cells(propName).Value - 1
48
49
Call draw
50
51
End Sub
52
53
54
Private Sub initSvcs()
55
Debug.Print "initSvcs"
56
Set svcs = CreateObject("Scripting.Dictionary")
57
Dim thissvc As svc
58
Dim parentsvc As svc
59
60
'定義行 読み取り
61
Dim i As Integer: i = 0
62
While Not Range(firstLine).Offset(i, 0).Value = ""
63
Set thissvc = New svc
64
thissvc.cells.Add "name", Range(firstLine).Offset(i, 0)
65
thissvc.cells.Add "parentName", Range(firstLine).Offset(i, 1)
66
thissvc.cells.Add "xFromParent", Range(firstLine).Offset(i, 2)
67
thissvc.cells.Add "yFromParent", Range(firstLine).Offset(i, 3)
68
thissvc.cells.Add "originX", Range(firstLine).Offset(i, 4)
69
thissvc.cells.Add "originY", Range(firstLine).Offset(i, 5)
70
thissvc.cells.Add "kakudo", Range(firstLine).Offset(i, 6)
71
72
svcs.Add thissvc.cells("name").Value, thissvc
73
74
i = i + 1
75
Wend
76
77
'親子関係作成
78
Dim key As Variant
79
For Each key In svcs
80
Set thissvc = svcs(key)
81
Dim parentName As String: parentName = thissvc.cells("parentName").Value
82
If parentName = "none" Then
83
Set topsvc = thissvc
84
Else
85
Set parentsvc = svcs(parentName)
86
parentsvc.children.Add thissvc.cells("name").Value, thissvc
87
End If
88
Next key
89
90
End Sub
91
Private Sub updateGentens()
92
Debug.Print "updateGentens"
93
Debug.Print "1"
94
'Set currentSVC = svcs(targetName)
95
96
Debug.Print "1"
97
Dim genten1 As shape: Set genten1 = ActiveSheet.Shapes("円/楕円 3")
98
canvasX = genten1.Left + genten1.Width / 2
99
canvasY = genten1.Top + genten1.Height / 2
100
101
Debug.Print "1"
102
103
End Sub
104
Private Sub draw()
105
Debug.Print "draw"
106
Set l = New LocalAxis
107
l.currentName = Range(firstLine).Offset(Range(spinButtonTop).Value - 1, 0).Value
108
109
Call l.save
110
Call l.translate(canvasX, canvasY)
111
Call draw_recursive(topsvc)
112
Call l.restore
113
114
End Sub
115
Private Sub draw_recursive(thissvc As svc)
116
Debug.Print "draw_recursive"
117
Dim thisName As String: thisName = thissvc.cells("name").Value
118
Dim thisshape As shape: Set thisshape = ActiveSheet.Shapes(thisName)
119
Dim parentName As String: parentName = thissvc.cells("parentName").Value
120
Dim thisXFromParent As Integer: thisXFromParent = thissvc.cells("xFromParent").Value
121
Dim thisYFromParent As Integer: thisYFromParent = thissvc.cells("yFromParent").Value
122
Dim thisOriginX As Integer: thisOriginX = thissvc.cells("originX").Value
123
Dim thisOriginY As Integer: thisOriginY = thissvc.cells("originY").Value
124
Dim thisKakudo As Integer: thisKakudo = thissvc.cells("kakudo").Value
125
126
l.save
127
Call l.translate(thisXFromParent, thisYFromParent)
128
Call l.rotateByKakudo(thisKakudo)
129
Call l.shapeDraw(thisshape, -thisOriginX, -thisOriginY)
130
131
132
Dim key As Variant
133
For Each key In thissvc.children
134
Dim childsvc As svc: Set childsvc = thissvc.children(key)
135
136
Call draw_recursive(childsvc)
137
Next key
138
l.restore
139
140
End Sub