DOS/V Power Report 1996 August/VPR9608A.BIN/vpr_data/vb32/vb4wm/vb4-4.cab/blanker.frm

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