home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 1996 November
/
VPR9611A.ISO
/
vpr_data
/
vb32
/
vb4wm
/
vb4-4.cab
/
blanker.frm
< prev
next >
Wrap
Text File
|
1996-01-12
|
25KB
|
739 lines
VERSION 4.00
Begin VB.Form DemoForm
BackColor = &H00000000&
Caption = "グラフィックス デモ"
ClientHeight = 4425
ClientLeft = 960
ClientTop = 1965
ClientWidth = 7470
BeginProperty Font
name = "標準ゴシック"
charset = 1
weight = 700
size = 9
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
Bold = 0
EndProperty
ForeColor = &H00000000&
Height = 5115
Icon = "BLANKER.frx":0000
Left = 900
LinkMode = 1 'ソース
LinkTopic = "Form1"
ScaleHeight = 4425
ScaleWidth = 7470
Top = 1335
Width = 7590
Begin VB.Timer Timer1
Interval = 1
Left = 6960
Top = 120
End
Begin VB.CommandButton cmdStartStop
BackColor = &H00000000&
Caption = "デモ開始"
Default = -1 'True
Height = 390
Left = 240
TabIndex = 0
Top = 120
Width = 1830
BeginProperty Font
name = "標準ゴシック"
size = 9
bold = 0
EndProperty
End
Begin VB.PictureBox picBall
AutoSize = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'なし
ForeColor = &H00FFFFFF&
Height = 480
Left = 1800
Picture = "BLANKER.frx":030A
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 1
Top = 720
Visible = 0 'False
Width = 480
BeginProperty Font
name = "標準ゴシック"
size = 9
bold = 0
EndProperty
End
Begin VB.Image imgMoon
Height = 480
Index = 8
Left = 6330
Picture = "BLANKER.frx":0614
Top = 3765
Visible = 0 'False
Width = 480
End
Begin VB.Line linLineCtl
BorderColor = &H00FF0000&
BorderWidth = 5
Visible = 0 'False
X1 = 240
X2 = 4080
Y1 = 2760
Y2 = 2760
End
Begin VB.Image imgMoon
Height = 480
Index = 7
Left = 5760
Picture = "BLANKER.frx":091E
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 6
Left = 5160
Picture = "BLANKER.frx":0C28
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 5
Left = 4560
Picture = "BLANKER.frx":0F32
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 4
Left = 3960
Picture = "BLANKER.frx":123C
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 3
Left = 3360
Picture = "BLANKER.frx":1546
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 2
Left = 2760
Picture = "BLANKER.frx":1850
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 1
Left = 2160
Picture = "BLANKER.frx":1B5A
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Image imgMoon
Height = 480
Index = 0
Left = 1560
Picture = "BLANKER.frx":1E64
Top = 3720
Visible = 0 'False
Width = 480
End
Begin VB.Shape shpClone
BackColor = &H00000000&
BackStyle = 1 '不透明
BorderColor = &H00FF0000&
FillColor = &H000000FF&
Height = 1215
Index = 0
Left = 240
Top = 720
Visible = 0 'False
Width = 1410
End
Begin VB.Shape Shape1
Height = 15
Left = 960
Top = 1080
Width = 15
End
Begin VB.Menu mnuOption
Caption = "オプション(&O)"
Begin VB.Menu mnuLineCtlDemo
Caption = "ジャンプ ライン(&J)"
Checked = -1 'True
End
Begin VB.Menu mnuCtlMoveDemo
Caption = "リバウンド(&B)"
End
Begin VB.Menu mnuImageDemo
Caption = "月の満ち欠け(&S)"
End
Begin VB.Menu mnuShapeDemo
Caption = "パレット(&M)"
End
Begin VB.Menu mnuPSetDemo
Caption = "紙ふぶき(&C)"
End
Begin VB.Menu mnuLineDemo
Caption = "十字砲火(&R)"
End
Begin VB.Menu mnuCircleDemo
Caption = "虹の絨毯(&W)"
End
Begin VB.Menu mnuScaleDemo
Caption = "カラーバー(&L)"
End
Begin VB.Menu sep1
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "終了(&X)"
End
End
End
Attribute VB_Name = "DemoForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' アニメーション フレームの軌跡を表す変数を宣言します。
Dim Shared FrameNum
' 軌跡位置の X 座標と Y 座標を表す変数を宣言します。
Dim Shared XPos
Dim Shared YPos
' Do Loop のグラフィック ルーチンを停止する変数フラグを宣言します。
Dim Shared DoFlag
' コントロールの移動を表す変数を宣言します。
Dim Shared Motion
' 色の変数を宣言します。
Dim R
Dim G
Dim B
Private Sub CircleDemo()
' ローカル変数を宣言します。
Dim Radius
' ランダムな RGB 色を作成します。
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' フォームの中央に円の中央を位置付けます。
XPos = ScaleWidth / 2
YPos = ScaleHeight / 2
' ゼロからフォームの高さの半分までの半径を作ります。
Radius = ((YPos * 0.9) + 1) * Rnd
' フォーム上に円を描きます。
Circle (XPos, YPos), Radius, RGB(R, G, B)
End Sub
Private Sub cmdStartStop_Click()
' ローカル変数を宣言します。
Dim UnClone
Dim MakeClone
Dim X1
Dim Y1
Select Case DoFlag
Case True
cmdStartStop.Caption = "デモ開始"
DoFlag = False
mnuOption.Enabled = True
If mnuCtlMoveDemo.Checked = True Then
' 飛び跳ねるグラフィックを再び非表示状態にします。
picBall.Visible = False
ElseIf mnuLineDemo.Checked = True Then
' フォーム上の線画を消去します。
Cls
ElseIf mnuShapeDemo.Checked = True Then
' 動的にロードされたシェイプ コントロールをすべて取り除きます。
For UnClone = 1 To 20
Unload shpClone(UnClone)
Next UnClone
' フォームの背景色を黒にリセットします。
DemoForm.BackColor = QBColor(0)
' フォームをリフレッシュして、色の変更を有効にします。
Refresh
ElseIf mnuPSetDemo.Checked = True Then
' 紙ふぶきをフォームから取り除きます。
Cls
ElseIf mnuLineCtlDemo.Checked = True Then
' ライン コントロールを再び非表示状態にします。
linLineCtl.Visible = False
' 線の非表示後に残るピクセルを取り除きます。
Cls
ElseIf mnuImageDemo.Checked = True Then
' 飛び跳ねるグラフィックを再び非表示状態にします。
imgMoon(0).Visible = False
ElseIf mnuScaleDemo.Checked = True Then
' フォームをクリアします。
Cls
' フォームを既定のスケールに戻します。
Scale
ElseIf mnuCircleDemo.Checked = True Then
' フォームから円を取り除きます。
Cls
End If
Case False
cmdStartStop.Caption = "デモ停止"
DoFlag = True
mnuOption.Enabled = False
If mnuCtlMoveDemo.Checked = True Then
' 飛び跳ねるグラフィック (ピクチャ ボックス コントロール) を表示状態にします。
picBall.Visible = True
' 飛び跳ねるグラフィックの最初の動きをランダムに確定します。
' 設定値は 1 から 4 までです。
' Motion 変数は Do Loop ルーチンの実行部分を決定します。
Motion = Int(4 * Rnd + 1)
ElseIf mnuLineDemo.Checked = True Then
' 乱数ジェネレータを初期化します。
Randomize
' 線の幅を設定します。
DrawWidth = 2
' 最初の X 座標と Y 座標をフォーム上のランダムな位置に設定します。
X1 = Int(DemoForm.Width * Rnd + 1)
Y1 = Int(DemoForm.Height * Rnd + 1)
ElseIf mnuShapeDemo.Checked = True Then
' フォーム上に 20 個のシェイプ コントロールからなるコントロール配列を動的にロードします。
For MakeClone = 1 To 20
Load shpClone(MakeClone)
Next MakeClone
ElseIf mnuPSetDemo.Checked = True Then
' 紙ふぶきの厚みを設定します。
DrawWidth = 5
ElseIf mnuLineCtlDemo.Checked = True Then
' ライン コントロールを表示状態にします。
linLineCtl.Visible = True
' 表示される線の太さを設定します。
DrawWidth = 7
ElseIf mnuImageDemo.Checked = True Then
' 飛び跳ねるグラフィック (イメージ コントロール) を表示状態にします。
imgMoon(0).Visible = True
' 最初のアニメーション フレームを設定します。
FrameNum = 0
' 飛び跳ねるグラフィックの最初の動きをランダムに決定します。
' 設定値は 1 から 4 までです。
' Motion 変数は Do Looop ルーチンの実行部分を決定します。
Motion = Int(4 * Rnd + 1)
ElseIf mnuScaleDemo.Checked = True Then
' 乱数ジェネレータを初期化します。
Randomize
' ボックスが重なり合わないようにボックス アウトラインの幅を設定します。
DrawWidth = 1
' X 座標の値をフォームの左端に設定します。
' 最初のボックスの X 座標を 1 に、2 番目のボックスの X 座標を 2 とし、
' 以下同様に設定します。
ScaleLeft = 1
' フォームの上端の Y 座標を 10 に設定します。
ScaleTop = 10
' フォームの幅の単位数を 3 から 12 の間にランダムに設定します。
' これにより、ルーチンが開始するたびに
' 異なる数のボックスが描かれることになります。
ScaleWidth = Int(13 * Rnd + 3)
' フォームの高さの単位数を -10 に設定します。これにより
' ボックスの高さが 0 から 10 までの間で変化し、
' Y 座標がフォームの下端から始まることになります。
ScaleHeight = -10
ElseIf mnuCircleDemo.Checked = True Then
' 円のアウトラインの幅を設定します。
DrawWidth = 1
' 描く線を鎖線に設定します。
DrawStyle = vbDash
' 描く線を XOR pen モードに設定します。ペンと表示色のどちらか
' 一方だけに含まれている色を組み合わせます。
DrawMode = vbXorPen
End If
End Select
End Sub
Private Sub CtlMoveDemo()
Select Case Motion
Case 1
' Move メソッドを使って、グラフィックを左上に 20 twip ずつ移動します。
picBall.Move picBall.Left - 20, picBall.Top - 20
' グラフィックがフォームの左端に達したら、右上に方向を変更します。
If picBall.Left <= 0 Then
Motion = 2
' グラフィックがフォーム上端に達したら、左下に方向を変更します。
ElseIf picBall.Top <= 0 Then
Motion = 4
End If
Case 2
' グラフィックを右上に 20 twip ずつ移動します。
picBall.Move picBall.Left + 20, picBall.Top - 20
' グラフィックがフォームの右端に達したら、左上に方向を変更します。
' フォームの幅からグラフィックの幅を差し引いて、
' フォームの右端を調べます。
If picBall.Left >= (DemoForm.Width - picBall.Width) Then
Motion = 1
' グラフィックがフォームの上端に達したら、右下に方向を変更します。
ElseIf picBall.Top <= 0 Then
Motion = 3
End If
Case 3
' グラフィックを右下に 20 twip ずつ移動します。
picBall.Move picBall.Left + 20, picBall.Top + 20
' グラフィックがフォームの右端に達したら、左下に方向を変更します。
If picBall.Left >= (DemoForm.Width - picBall.Width) Then
Motion = 4
' グラフィックがフォームの下端に達したら、右上に方向を変更します。
' フォームの高さからグラフィックの高さを差し引き、さらにそこから
' 680 twip (タイトル バーとメニューバーの高さ) を差し引いてフォームの下端を調べます。
ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
Motion = 2
End If
Case 4
' グラフィックを左下に 20 twip ずつ移動します。
picBall.Move picBall.Left - 20, picBall.Top + 20
' グラフィックがフォームの左端に達したら、右下に方向を変更します。
If picBall.Left <= 0 Then
Motion = 3
' グラフィックがフォームの下端に達したら、左上に方向を変更します。
ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
Motion = 1
End If
End Select
End Sub
Private Sub Delay()
Dim Start
Dim Check
Start = Timer
Do Until Check >= Start + 0.15
Check = Timer
Loop
End Sub
Private Sub Form_Load()
DoFlag = False
End Sub
Private Sub Form_Resize()
If mnuScaleDemo.Checked = True And DemoForm.WindowState = 0 Then
' 乱数ジェネレータを初期化します。
Randomize
' ボックスが重ならないようにボックス アウトラインの幅を狭く設定します。
DrawWidth = 1
' フォームの左端の X 座標を 1 に設定します。
' こうすれば、ボックスの位置の設定が容易になります。
' 最初のボックスの X 座標は 1、そして 2 番目のボックスの X 座標は 2 となり、
' 以下同様に続きます。
ScaleLeft = 1
' フォームの上端の Y 座標を 10 に設定します。
ScaleTop = 10
' フォームの幅の単位数を 3 から 12 に間にランダムに設定します。
' これにより、ルーチンが開始するたびに
' 異なる数のボックスが描かれることになります。
ScaleWidth = Int(13 * Rnd + 3)
' フォームの高さの単位数を -10 に設定します。
' これには 2 つの効果があります。
' 1 つは、ボックスの高さが 0 から 10 までの間で変化することであり、
' もう 1 つは、負の値を設定することにより、フォームの上端からではなく
' 下端から Y 座標が始まることです。
ScaleHeight = -10
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub ImageDemo()
Select Case Motion
Case 1
' Move メソッドを使って、グラフィックを左上に 100 twip ずつ移動します。
imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top - 100
' アニメーションを次のフレームに更新します。
IncrFrame
' グラフィックがフォームの左端に達したら、右上に方向を変更します。
If imgMoon(0).Left <= 0 Then
Motion = 2
' グラフィックがフォームの上端に達したら、左下に方向を変更します。
ElseIf imgMoon(0).Top <= 0 Then
Motion = 4
End If
Case 2
' グラフィックを右上に 100 twip ずつ移動します。
imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top - 100
' アニメーションを次のフレームに更新します。
IncrFrame
' グラフィックがフォームの右端に達したら、左上に方向を変更します。
' コントロールの幅からグラフィックの幅を差し引いて、
' フォームの右端を調べます。
If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
Motion = 1
' グラフィックがフォームの上端に達したら、右下に方向を変更します。
ElseIf imgMoon(0).Top <= 0 Then
Motion = 3
End If
Case 3
' グラフィックを右下に 100 twip ずつ移動します。
imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top + 100
' アニメーションを次のフレームに更新します。
IncrFrame
' グラフィックが右端に達したら、左下に方向を変更します。
If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
Motion = 4
' グラフィックがフォームの下端に達したら、右上に方向を変更します。
' フォームの高さからグラフィックの高さを差し引き、さらに
' そこから 680 twip (タイトル バーとメニュー バーの高さ) を差し引いて
' フォームの下端を調べます。
ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
Motion = 2
End If
Case 4
' グラフィックを左下に 100 twip ずつ移動します。
imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top + 100
' アニメーションを次のフレームに更新します。
IncrFrame
' グラフィックがフォームの左端に達したら、右下に方向を変更します。
If imgMoon(0).Left <= 0 Then
Motion = 3
' グラフィックがフォームの下端に達したら、左上に方向を変更します。
ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
Motion = 1
End If
End Select
End Sub
Private Sub IncrFrame()
' フレーム番号をインクリメントします。
FrameNum = FrameNum + 1
' アニメーション フレームのコントロール配列には、0 から 7 までの要素があります。
' 8 番めのフレームでフレーム番号が 0 にリセットされ、アニメーションのループが繰り返されます。
If FrameNum > 8 Then
FrameNum = 1
End If
' イメージ コントロールの Picture プロパティを、現在のフレームの Picture プロパティに設定します。
imgMoon(0).Picture = imgMoon(FrameNum).Picture
' アニメーションが速くなりすぎないよう、表示を遅らせます。
Delay
End Sub
Private Sub LineCtlDemo()
' 線の開始点の X 座標と Y 座標をフォーム上にランダムに設定します。
linLineCtl.X1 = Int(DemoForm.Width * Rnd)
linLineCtl.Y1 = Int(DemoForm.Height * Rnd)
' 線の終了点の X 座標と Y 座標をフォーム上にランダムに設定します。
linLineCtl.X2 = Int(DemoForm.Width * Rnd)
linLineCtl.Y2 = Int(DemoForm.Height * Rnd)
' フォームをクリアして、残っているピクセルを除去します。
Cls
' 線の移動を再開する前に、表示を遅らせます。
Delay
End Sub
Private Sub LineDemo()
' ローカル変数を宣言します。
Dim X2
Dim Y2
' ランダムな RGB 色を作成します。
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' ライン コントロールの終了点をフォーム上にランダムに設定します。
X2 = Int(DemoForm.Width * Rnd + 1)
Y2 = Int(DemoForm.Height * Rnd + 1)
' Line メソッドを使って、現在の座標から現在の終了点へ、
' ランダムな色で線を描きます。直前の線の終了点が次の線の開始点になります。
Line -(X2, Y2), RGB(R, G, B)
End Sub
Private Sub mnuCircleDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = True
End Sub
Private Sub mnuCtlMoveDemo_Click()
Cls
mnuCtlMoveDemo.Checked = True
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuExit_Click()
End
End Sub
Private Sub mnuImageDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = True
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuLineCtlDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = True
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuLineDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = True
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuPSetDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = True
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuScaleDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = True
mnuCircleDemo.Checked = False
End Sub
Private Sub mnuShapeDemo_Click()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = True
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Private Sub PSetDemo()
' ランダムな RGB 色を作成します。
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' XPos により、紙ふぶきの水平位置をフォーム上にランダムに設定します。
XPos = Rnd * ScaleWidth
' YPos により、紙ふぶきの垂直位置をフォーム上にランダムに設定します。
YPos = Rnd * ScaleHeight
' XPos と YPos の位置に紙ふぶきを描き、ランダムな色を割り当てます。
PSet (XPos, YPos), RGB(R, G, B)
End Sub
Private Sub ScaleDemo()
' ローカル変数を宣言します。
Dim Box
' フォームの幅の単位数と同じ数のボックスを作成します。
For Box = 1 To ScaleWidth
' ランダムな RGB 色を作成します。
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' B オプション (ボックス) と F オプション (塗りつぶし) を指定した Line メソッドを使ってボックスを描きます。
' ScaleWidth によって設定された X 座標および 0 の Y 座標 (フォームの下端) がボックスの開始点になります。
' ボックスの幅は 1 単位、高さは 0 から 10 までのランダムな値となります。
' ボックスはランダムな色で塗りつぶされます。
Line (Box, 0)-Step(1, (Int(11 * Rnd))), RGB(R, G, B), BF
Next Box
' 再描画の前に、すべてのボックスの表示をいったん停止します。
Delay
End Sub
Private Sub ShapeDemo()
' ローカル変数を宣言します。
Dim CloneID
' ランダムな RGB 色を作成します。
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' フォームの背景色をランダムに設定します。
DemoForm.BackColor = RGB(R, G, B)
' コントロール配列の中のシェイプ コントロールをランダムに選択します。
CloneID = Int(20 * Rnd + 1)
' XPos と YPos により、選択したシェイプ コントロールの位置をフォーム上にランダムに設定します。
XPos = Int(DemoForm.Width * Rnd + 1)
YPos = Int(DemoForm.Height * Rnd + 1)
' 選択したシェイプ コントロールの形をランダムに設定します。
shpClone(CloneID).Shape = Int(6 * Rnd)
' 選択したシェイプ コントロールの高さと幅を、500 twip から 2500 twip の間でランダムに設定します。
shpClone(CloneID).Height = Int(2501 * Rnd + 500)
shpClone(CloneID).Width = Int(2501 * Rnd + 500)
' シェイプ コントロールの背景色と DrawMode プロパティの色をランダムに設定します。
shpClone(CloneID).BackColor = QBColor(Int(15 * Rnd))
shpClone(CloneID).DrawMode = Int(16 * Rnd + 1)
' 選択したシェイプ コントロールを XPos と YPos の位置に移動します。
shpClone(CloneID).Move XPos, YPos
' 選択したシェイプ コントロールを表示状態にします。
shpClone(CloneID).Visible = True
' 次のシェイプ コントロールを選択し変更する前に少し待ちます。
Delay
End Sub
Private Sub Timer1_Timer()
If mnuCtlMoveDemo.Checked And DoFlag = True Then
CtlMoveDemo
ElseIf mnuLineDemo.Checked And DoFlag = True Then
LineDemo
ElseIf mnuShapeDemo.Checked And DoFlag = True Then
ShapeDemo
ElseIf mnuPSetDemo.Checked And DoFlag = True Then
PSetDemo
ElseIf mnuLineCtlDemo.Checked And DoFlag = True Then
LineCtlDemo
ElseIf mnuImageDemo.Checked And DoFlag = True Then
ImageDemo
ElseIf mnuScaleDemo.Checked And DoFlag = True Then
ScaleDemo
ElseIf mnuCircleDemo.Checked And DoFlag = True Then
CircleDemo
End If
End Sub