Liren Large Software Subsidy 10/10.iso/l/l406/1.ddi/BLANKER.FR_/BLANKER.bin

Visual Basic Form | 1992-10-21 | 21.7 KB | 681 lines

VERSION 2.00
Begin Form DemoForm
   BackColor       =   &H00000000&
   Caption         =   "Screen Blanker Demo"
   ForeColor       =   &H00000000&
   Height          =   5115
   Icon            =   BLANKER.FRX:0000
   Left            =   900
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   Picture         =   BLANKER.FRX:0302
   ScaleHeight     =   4425
   ScaleWidth      =   7470
   Top             =   1335
   Width           =   7590
   Begin Timer Timer1
      Interval        =   1
      Left            =   6960
      Top             =   120
   End
   Begin CommandButton cmdStartStop
      BackColor       =   &H00000000&
      Caption         =   "Start Demo"
      Default         =   -1  'True
      Height          =   390
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1830
   End
   Begin PictureBox picBall
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      BorderStyle     =   0  'None
      ForeColor       =   &H00FFFFFF&
      Height          =   600
      Left            =   1800
      Picture         =   BLANKER.FRX:0740
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   1
      Top             =   720
      Visible         =   0   'False
      Width           =   600
   End
   Begin Line linLineCtl
      BorderColor     =   &H00FF0000&
      BorderWidth     =   5
      Visible         =   0   'False
      X1              =   240
      X2              =   4080
      Y1              =   2760
      Y2              =   2760
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   7
      Left            =   5760
      Picture         =   BLANKER.FRX:0A42
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   6
      Left            =   5160
      Picture         =   BLANKER.FRX:0D44
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   5
      Left            =   4560
      Picture         =   BLANKER.FRX:1046
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   4
      Left            =   3960
      Picture         =   BLANKER.FRX:1348
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   3
      Left            =   3360
      Picture         =   BLANKER.FRX:164A
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   2
      Left            =   2760
      Picture         =   BLANKER.FRX:194C
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   1
      Left            =   2160
      Picture         =   BLANKER.FRX:1C4E
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Image imgMoon
      Height          =   480
      Index           =   0
      Left            =   1560
      Picture         =   BLANKER.FRX:1F50
      Top             =   3720
      Visible         =   0   'False
      Width           =   480
   End
   Begin Shape shpClone
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FF0000&
      FillColor       =   &H000000FF&
      Height          =   1215
      Index           =   0
      Left            =   240
      Top             =   720
      Visible         =   0   'False
      Width           =   1410
   End
   Begin Shape Shape1
      Height          =   15
      Left            =   960
      Top             =   1080
      Width           =   15
   End
   Begin Menu mnuOption
      Caption         =   "&Options"
      Begin Menu mnuLineCtlDemo
         Caption         =   "&Jumpy Line"
         Checked         =   -1  'True
      End
      Begin Menu mnuCtlMoveDemo
         Caption         =   "Re&bound"
      End
      Begin Menu mnuImageDemo
         Caption         =   "&Spinning Moon"
      End
      Begin Menu mnuShapeDemo
         Caption         =   "&Madhouse"
      End
      Begin Menu mnuPSetDemo
         Caption         =   "&Confetti"
      End
      Begin Menu mnuLineDemo
         Caption         =   "C&rossfire"
      End
      Begin Menu mnuCircleDemo
         Caption         =   "Rainbo&w Rug"
      End
      Begin Menu mnuScaleDemo
         Caption         =   "Co&lor Bars"
      End
      Begin Menu sep1
         Caption         =   "-"
      End
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
   End
Option Explicit
' Declare variable to track animation frame
Dim Shared FrameNum
' Declare the X and Y-coordinate variables to track position.
Dim Shared XPos
Dim Shared YPos
' Declare variable flag to stop graphic routines in Do Loops
Dim Shared DoFlag
' Declare variable to track moving controls
Dim Shared Motion
' Declare form variables for color.
Dim R
Dim G
Dim B
Sub CircleDemo ()
    ' Declare local variables
    Dim Radius
    ' Create random RGB colors
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Position center of circles in form center
    XPos = ScaleWidth / 2
    YPos = ScaleHeight / 2
    ' Generate radius between 0 and almost half form height
    Radius = ((YPos * .9) + 1) * Rnd
    ' Draw circle on form
    Circle (XPos, YPos), Radius, RGB(R, G, B)
End Sub
Sub cmdStartStop_Click ()
' Declare local variables.
Dim UnClone
Dim MakeClone
Dim X1
Dim Y1
    Select Case DoFlag
    Case True
        cmdStartStop.Caption = "Start Demo"
        DoFlag = False
        mnuOption.Enabled = True
        If mnuCtlMoveDemo.Checked = True Then
        ' Hide bouncing graphic again.
        picBall.Visible = False
        ElseIf mnuLineDemo.Checked = True Then
        ' Remove lines from the form.
        Cls
        ElseIf mnuShapeDemo.Checked = True Then
        ' Remove all dynamically loaded Shape controls.
        For UnClone = 1 To 20
            Unload shpClone(UnClone)
        Next UnClone
        ' Reset background color of form to black.
        DemoForm.BackColor = QBColor(0)
        ' Refresh form so color change takes effect.
        Refresh
        ElseIf mnuPSetDemo.Checked = True Then
        ' Remove confetti bits from form.
        Cls
        ElseIf mnuLineCtlDemo.Checked = True Then
        ' Hide Line control again.
        linLineCtl.Visible = False
        ' Remove any stray pixels left after hiding line.
        Cls
        ElseIf mnuImageDemo.Checked = True Then
        ' Hide bouncing graphic again.
        imgMoon(0).Visible = False
        ElseIf mnuScaleDemo.Checked = True Then
        ' Clear form.
        Cls
        ' Return form to the default scale.
        Scale
        ElseIf mnuCircleDemo.Checked = True Then
        ' Remove the circles from form.
        Cls
        End If
    Case False
        cmdStartStop.Caption = "Stop Demo"
        DoFlag = True
        mnuOption.Enabled = False
        If mnuCtlMoveDemo.Checked = True Then
        ' Make the bouncing graphic (Picture box control) visible.
        picBall.Visible = True
        ' Determine initial motion of bouncing graphic at random.
        ' Settings are 1 to 4.  Value of variable Motion determines
        ' what part of the Do Loop routine runs.
        Motion = Int(4 * Rnd + 1)
        ElseIf mnuLineDemo.Checked = True Then
        ' Initialize random-number generator.
        Randomize
        ' Set line width
        DrawWidth = 2
        ' Set initial X and Y-coordinates to a random spot on form
        X1 = Int(DemoForm.Width * Rnd + 1)
        Y1 = Int(DemoForm.height * Rnd + 1)
        ElseIf mnuShapeDemo.Checked = True Then
        ' Dynamically load a control array of 20 Shape controls on the form.
        For MakeClone = 1 To 20
            Load shpClone(MakeClone)
        Next MakeClone
        ElseIf mnuPSetDemo.Checked = True Then
        ' Set thickness of confetti bits.
        DrawWidth = 5
        ElseIf mnuLineCtlDemo.Checked = True Then
        ' Make Line control visible.
        linLineCtl.Visible = True
        ' Set thickness of line as it will appear.
        DrawWidth = 7
        ElseIf mnuImageDemo.Checked = True Then
        ' Make bouncing graphic (Image control) visible.
        imgMoon(0).Visible = True
        ' Set initial animation frame
        FrameNum = 0
        ' Determine initial motion of bouncing graphic at random.
        ' Settings are 1 to 4.  Value of variable Motion determines
        ' what part of the Do Loop routine runs.
        Motion = Int(4 * Rnd + 1)
        ElseIf mnuScaleDemo.Checked = True Then
        ' Initialize random-number generator.
        Randomize
        ' Set width of box outlines so boxes don't overlap.
        DrawWidth = 1
        ' Set value of X-coordinate of left edge of form. Then the 1st to 1 to easily
        ' box has X-coordinate = 1, 2nd box = 2, etc.
        ScaleLeft = 1
        ' Set Y-coordinate of top edge of form to 10.
        ScaleTop = 10
        ' Set # of units in form width to a random number between
        ' 3 and 12.  This changes # of boxes drawn each time the
        ' routine starts
        ScaleWidth = Int(13 * Rnd + 3)
        ' Set # of units in form height -10.  Then height of all boxes
        ' varies from 0 to 10 and Y-coordinates start at form bottom
        ScaleHeight = -10
        ElseIf mnuCircleDemo.Checked = True Then
        ' Define width of circle outline.
        DrawWidth = 1
        ' Draw circles as dashed lines.
        DrawStyle = 1
        ' Draw lines using the XOR pen, combining colors found in the pen and
        ' in the display but not in both.
        DrawMode = 7
        End If
    End Select
End Sub
Sub CtlMoveDemo ()
    Select Case Motion
    Case 1
    ' Move graphic left/up by 20 twips using Move method
    picBall.Move picBall.Left - 20, picBall.Top - 20
    ' If graphic reaches left edge of form, move it right/up
    If picBall.Left <= 0 Then
        Motion = 2
    ' If graphic reaches top edge of form, move it left/down
    ElseIf picBall.Top <= 0 Then
        Motion = 4
    End If
    Case 2
    ' Move graphic right/up by 20 twips
    picBall.Move picBall.Left + 20, picBall.Top - 20
    ' If the graphic reaches right edge of form, move left/up.
    ' Routine determines right edge of form by subtracting graphic
    ' width from form width
    If picBall.Left >= (DemoForm.Width - picBall.Width) Then
        Motion = 1
    ' If graphic reaches top edge of form, move right/down
    ElseIf picBall.Top <= 0 Then
        Motion = 3
    End If
    Case 3
    ' Move graphic right/down by 20 twips
    picBall.Move picBall.Left + 20, picBall.Top + 20
    ' If graphic reaches right edge of form, move left/down
    If picBall.Left >= (DemoForm.Width - picBall.Width) Then
        Motion = 4
    ' If graphic reaches bottom edge of form, move right/up.
    ' Routine determines bottom of form by subtracting
    ' graphic height from form height less 680 twips for height
    ' of title bar and menu bar
    ElseIf picBall.Top >= (DemoForm.height - picBall.height) - 680 Then
        Motion = 2
    End If
    Case 4
    ' Move the graphic left/down by 20 twips
    picBall.Move picBall.Left - 20, picBall.Top + 20
    ' If graphic reaches left edge of form, move right/down
    If picBall.Left <= 0 Then
        Motion = 3
    ' If graphic reaches bottom edge of the form, move left/up
    ElseIf picBall.Top >= (DemoForm.height - picBall.height) - 680 Then
        Motion = 1
    End If
    End Select
End Sub
Sub Delay ()
    Dim Start
    Dim Check
    Start = Timer
    Do Until Check >= Start + .15
    Check = Timer
    Loop
End Sub
Sub Form_Load ()
    DoFlag = False
End Sub
Sub Form_Resize ()
    If mnuScaleDemo.Checked = True Then
    ' Initialize the random-number generator.
    Randomize
    ' Set the width of the box outlines to narrow so the boxes don't overlap.
    DrawWidth = 1
    ' Set the value of the X-coordinate of the left edge of the form to 1.
    ' This makes it easy to set the position for each box.  The first box has
    ' an X-coordinate of 1, the second has an X-coordinate of 2, etc.
    ScaleLeft = 1
    ' Set the value of the Y-coordinate of the top edge of the form to 10.
    ScaleTop = 10
    ' Set the number of units in the width of the form to a random number between
    ' 3 and 12.  This changes the number of boxes that are drawn each time the user
    ' starts this routine.
    ScaleWidth = Int(13 * Rnd + 3)
    ' Set the number of units in the height of the form to negative 10.  This has
    ' two effects.  First, all the boxes then have a height that varies from 0 to 10.
    ' Second, the negative value causes the Y-coordinates to begin at the bottom
    ' edge of the form instead of at the top.
    ScaleHeight = -10
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    End
End Sub
Sub ImageDemo ()
    Select Case Motion
    Case 1
    ' Move graphic left/up by 100 twips using Move method
    imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top - 100
    ' Increment animation to next frame
    IncrFrame
    ' If graphic reaches left edge of form, move right/up
    If imgMoon(0).Left <= 0 Then
        Motion = 2
    ' If graphic reaches top edge of the form, move left/down
    ElseIf imgMoon(0).Top <= 0 Then
        Motion = 4
    End If
    Case 2
    ' Move graphic right/up by 100 twips
    imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top - 100
    ' Increment animation to next frame
    IncrFrame
    ' If graphic reaches right edge of form, move left/up.
    ' Routine determines the right edge of form by subtracting
    ' graphic width from control width
    If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
        Motion = 1
    ' If graphic reaches top edge of the form, move right/down
    ElseIf imgMoon(0).Top <= 0 Then
        Motion = 3
    End If
    Case 3
    ' Move graphic right/down by 100 twips
    imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top + 100
    ' Increment animation to next frame
    IncrFrame
    ' If graphic reaches right edge of form, move left/down
    If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
        Motion = 4
    ' If graphic reaches bottom edge of form, move right/up.
    ' Routine determines bottom edge of form by subtracting graphic
    ' height from form height minus 680 twips for height of title
    ' bar and menu bar
    ElseIf imgMoon(0).Top >= (DemoForm.height - imgMoon(0).height) - 680 Then
        Motion = 2
    End If
    Case 4
    ' Move graphic left/down by 100 twips
    imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top + 100
    ' Increment animation to next frame
    IncrFrame
    ' If graphic reaches left edge of form, move right/down
    If imgMoon(0).Left <= 0 Then
        Motion = 3
    ' If graphic reaches bottom edge of form, move left/up
    ElseIf imgMoon(0).Top >= (DemoForm.height - imgMoon(0).height) - 680 Then
        Motion = 1
    End If
    End Select
End Sub
Sub IncrFrame ()
    ' Increment frame #
    FrameNum = FrameNum + 1
    ' Control array with animation frames has elements 0 to 7. At the 8th
    ' frame, reset the frame # to 0 for endless animation loop
    If FrameNum > 7 Then
    FrameNum = 0
    End If
    ' Set Picture property of image control to Picture property of current
    ' frame
    imgMoon(0).Picture = imgMoon(FrameNum).Picture
    ' Pause display so animation isn't too fast
    Delay
End Sub
Sub LineCtlDemo ()
    ' Set X and Y-coordinates (left/right position) of line's start to
    ' random spot on form
    linLineCtl.X1 = Int(DemoForm.Width * Rnd)
    linLineCtl.Y1 = Int(DemoForm.height * Rnd)
    ' Set X and Y-coordinates (left/right position) of line's end to
    ' random spot on form
    linLineCtl.X2 = Int(DemoForm.Width * Rnd)
    linLineCtl.Y2 = Int(DemoForm.height * Rnd)
    ' Clear form to remove any stray pixels
    Cls
    ' Pause display before moving line again
    Delay
End Sub
Sub LineDemo ()
    ' Declare local variables
    Dim X2
    Dim Y2
    ' Create random RGB colors
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Set end point of line to random spot on form
    X2 = Int(DemoForm.Width * Rnd + 1)
    Y2 = Int(DemoForm.height * Rnd + 1)
    ' Using Line method, draw from current coordinates to current end
    ' point, giving line a random color. Each line starts where last
    ' line ends.
    Line -(X2, Y2), RGB(R, G, B)
End Sub
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
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
Sub mnuExit_Click ()
    End
End Sub
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
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
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
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
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
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
Sub PSetDemo ()
    ' Create random RGB colors
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Xpos sets horiz position of confetti bit to random spot on form
    XPos = Rnd * ScaleWidth
    ' YPos sets vertical position of confetti bit to random spot on form
    YPos = Rnd * ScaleHeight
    ' Draw confetti bit at XPos, Ypos. Assign confetti bit a random color
    PSet (XPos, YPos), RGB(R, G, B)
End Sub
Sub ScaleDemo ()
    ' Declare local variables
    Dim Box
    ' Creates same number of boxes as units in the width of form
    For Box = 1 To ScaleWidth
    ' Create random RGB colors
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Draw boxes using te Line method with B (box) F (filled) options.
    ' Boxes start at each X-coordinate determined by ScaleWidth and at
    ' a Y-coordinate of 0 (bottom of form). Each box is 1 unit wide and
    ' has a random height between 0 and 10. Fill box with random color.
    Line (Box, 0)-Step(1, (Int(11 * Rnd))), RGB(R, G, B), BF
    Next Box
    ' Pause to display all boxes before redraw
    Delay
End Sub
Sub ShapeDemo ()
    ' Declare local variables
    Dim CloneID
    ' Create random RGB colors
    R = 255 * Rnd
    G = 255 * Rnd
    B = 255 * Rnd
    ' Set form background color to random value
    DemoForm.BackColor = RGB(R, G, B)
    ' Select random Shape control in control array
    CloneID = Int(20 * Rnd + 1)
    ' XPos and Ypos set position of selected Shape control to random
    ' spot on the form.
    XPos = Int(DemoForm.Width * Rnd + 1)
    YPos = Int(DemoForm.height * Rnd + 1)
    ' Set the shape of the selected Shape control to a random shape.
    shpClone(CloneID).Shape = Int(6 * Rnd)
    ' Set height/width of selected Shape control to random size between
    ' 500 and 2500 twips
    shpClone(CloneID).height = Int(2501 * Rnd + 500)
    shpClone(CloneID).Width = Int(2501 * Rnd + 500)
    ' Set background color and DrawMode of Shape control to random color
    shpClone(CloneID).BackColor = QBColor(Int(15 * Rnd))
    shpClone(CloneID).DrawMode = Int(16 * Rnd + 1)
    ' Move selected Shape control using Move method to XPos, YPos
    shpClone(CloneID).Move XPos, YPos
    ' Make the selected Shape control visible.
    shpClone(CloneID).Visible = True
    ' Wait briefly before selecting and changing the next Shape control.
    Delay
End Sub
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