| |
▼文哉 さん：
こんにちは
テーマがおもしろいので、ちょっと遊んでみました。
文哉さんの意図は「お掃除ロボット」のようなスムーズな動きかもしれませんが
「よっぱらいの千鳥足」をイメージしています。
壁際では、壁に向かって進んで頭をぶつけることもあると思いますし、一歩踏み出して
よろよろっと、そんな感じをだせないかなと。
まだ、未完成というか、以下の点が気に入らないのですが。
・だんだん意識が暗くなっていくことをイメージして、色合いを濃くしていってるんですが
今は４段階ぐらい、これを、もう少し細かな移り変わりにできたらと。
・左右上下に移動方向を限定しているつもりなんですが、斜めにも移動。バグでしょうね。
なお、実行中に、任意の文字を入力すれば終了します。
Sub 酔っ払い()
Dim myRGB As Integer
Dim myRow As Long, myCol As Long
Dim x As Long, y As Long, z As Long, i As Long
Dim rtn As Long, svColor As Long, mySeq As Long
Cells.Clear
myRGB = 200 '開始時の色合い
Do
Sleep 50
DoEvents
DoEvents
With ActiveCell
myRow = .Row
myCol = .Column
End With
x = Int((1 - (-1) + 1) * Rnd + (-1))
y = Int((1 - (-1) + 1) * Rnd + (-1))
If myRow + y < 1 Or myRow + y > Rows.Count Then y = 0
If myCol + x < 1 Or myCol + x > Columns.Count Then x = 0
If x <> 0 Or y <> 0 Then ActiveCell.Offset(y, x).Activate
With ActiveCell
svColor = RGB(myRGB, myRGB, myRGB)
For i = 1 To 10
.Interior.Color = vbBlack
Sleep 30
DoEvents
.Interior.Color = svColor
Sleep 30
DoEvents
Next
.Interior.Color = svColor
mySeq = mySeq + 1
.Value = mySeq
.ShrinkToFit = True '縮小して全てを表示
.Font.Color = RGB(255, 255, 255) '文字色は白抜き
myRGB = myRGB - 1 '次の色用
End With
Loop
End Sub
|
|
UO3
- 11/6/17(金) 11:45 -
