home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form DemoForm
- BackColor = &H00000000&
- Caption = "Screen Blanker Demo"
- ClientHeight = 4425
- ClientLeft = 960
- ClientTop = 1965
- ClientWidth = 7470
- 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 Image imgMoon
- Height = 480
- Index = 8
- Left = 6330
- Picture = BLANKER.FRX:0A42
- Top = 3765
- Visible = 0 'False
- Width = 480
- 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:0D44
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 6
- Left = 5160
- Picture = BLANKER.FRX:1046
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 5
- Left = 4560
- Picture = BLANKER.FRX:1348
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 4
- Left = 3960
- Picture = BLANKER.FRX:164A
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 3
- Left = 3360
- Picture = BLANKER.FRX:194C
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 2
- Left = 2760
- Picture = BLANKER.FRX:1C4E
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 1
- Left = 2160
- Picture = BLANKER.FRX:1F50
- Top = 3720
- Visible = 0 'False
- Width = 480
- End
- Begin Image imgMoon
- Height = 480
- Index = 0
- Left = 1560
- Picture = BLANKER.FRX:2252
- 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 > 8 Then
- FrameNum = 1
- 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
-