Liren Large Software Subsidy 10

home *** CD-ROM | disk | FTP | other *** search

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

(.txt)

Wrap

Visual Basic Form | 1993-04-28 | 22.1 KB | 694 lines

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