| |
こんにちわ。
>頂点の移動の際に任意の場所で止めたり、再開したりしたい
Waitでは特定のプロシージャ内で実行が一時停止されるだけです。
任意に停止／再開を繰り替えすんやったら、一旦プロシージャを抜けるようにして、
フラグで判定すればええんとちゃいまっか？
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Triangle As Shape
Private CurrentPos As Single
Private Flg As Boolean
Sub 三角形の描画()
If Not Flg Then
図の削除
With ActiveSheet.Shapes
With .BuildFreeform(msoEditingAuto, 200, 200)
.AddNodes msoSegmentLine, msoEditingAuto, 340, 100
.AddNodes msoSegmentLine, msoEditingAuto, 400, 200
.AddNodes msoSegmentLine, msoEditingAuto, 200, 200
Set Triangle = .ConvertToShape
End With
With Triangle
.Fill.Visible = msoFalse
.Fill.ForeColor.RGB = vbRed
.Line.DashStyle = msoLineDash
End With
DoEvents
Sleep 1000
.AddLine(50, 200, 600, 200).Line.DashStyle = msoLineDashDot
.AddLine(50, 100, 600, 100).Line.DashStyle = msoLineDashDot
.AddLine 200, 200, 400, 200
End With
CurrentPos = 0
End If
End Sub
Sub 移動開始()
If Not Flg Then
Flg = True
CurrentPos = 頂点の移動(CurrentPos)
End If
End Sub
Function 頂点の移動(ByVal Counter As Long) As Long
Dim i As Long
With Triangle
With .Nodes
For i = Counter To 250 Step 2
If Flg Then
If Counter = 250 Then Flg = False
.SetPosition 2, 340 + i, 100
DoEvents
Sleep 100
Else
頂点の移動 = i
Exit Function
End If
Next
End With
.Fill.Visible = msoTrue
.Line.DashStyle = msoLineSolid
End With
Flg = False
頂点の移動 = 0
End Function
Sub 頂点を元に戻す()
If Not Flg Then
With Triangle
.Nodes.SetPosition 2, 340, 100
.Fill.Visible = msoFalse
.Line.DashStyle = msoLineDash
End With
CurrentPos = 0
DoEvents
End If
End Sub
Sub 図の削除()
On Error Resume Next
If Not Flg Then
ActiveSheet.Lines.Delete
Triangle.Delete
Set Triangle = Nothing
CurrentPos = 0
Flg = False
End If
End Sub
Sub 一時停止()
If Flg Then Flg = False
End Sub
「移動開始」で変形を開始して、「一時停止」でストップ。
再開はもう一度「移動開始」です。
試してみてな。
ほな。
|
|
ｂｙｋｉｎ
- 05/2/13(日) 14:01 -
