39 animation effects based on VB algorithm + Picture + Timer control, similar screensaver (complete original procedure)

39 animation effects based on VB algorithm Picture Timer control, similar screensaver (complete original procedure)

Animation player program, in Win2003 debugging, please download your own learning test, 13K

Download address: http://www.lshdic.com/download/lshdic/vb_xiaoguo.rar

Code Browse:

DIM XIAOGUO AS INTEGER 'Choosing the resulting effect DIM WID AS Long' Monitor's High Dim POS1 AS Long 'Generating Effect The color effect of the spectrum DIM coloris as integer' is selected by the user, 0 = Random Arbitrary color, 1 = Random Gradient DIM ColorStart (2) AS INTEGER 'When the random gradient is selected, the array determines whether or white or white One side of Dim Heibaicolor As INTEGER 'Range 0-255, in order to record black and white contrast, black and white gradual color, black and white grayscale Dim Lihe as boolean' is the kiss of the world, the heart of sleeping DIM POS2 AS LONG 'to make a continuous spraying effect for the fire of hell, DIM XX () as long' is the traditional life of life, and the amount of movement of the sphere to the right DIM YY () as long 'is prioruous, calculating the sphere downwards. Movement DIM JIAX () as boolean 'To complete life, calculation is calculated or reduced to completion of life, calculating whether to increase or decrease YYDIM RectMax as integer' to complete "data array", calculate X , Y's largest array DIM hang as integer 'is the "modern remark", calculated the first few lines of DIM POS3 AS long' to complete "rotary light", calculate the movement of the second line DIM BCOLOR AS STRING 'is history. Record the background color of the saved canvas

Private sub fascist1_click (index as integer) '39 buttons Receive Click Event (Initialization Effect) P.cls: p.currentx = 0: P.Currenty = 0: POS1 = 0: POS2 = 0: P.FillColor = Bcolorp.fontsize = 9: p.FontBold = false: p.backcolor = bcolor: lihe = falsep.fillstyle = 1: POS3 = 0 'upper three-line initialization player Select Case indexcase 5: P.drawidth = 10' Drawidth definition line segment The thickness of Case 7: P.drawWidth = 8case 8: p.drawidth = 9case 9: p.drawidth = 3case 10: p.drawidth = 3case 11: p.drawidth = 3case 12: p.drawidth = 3case 13: P. DrawWidth = 3case 14: p.drawidth = 6case 15: p.drawidth = 3case 16: p.drawidth = 3case 17: p.drawidth = 3case 18: p.drawidth = 5case 19: redim xx (5): Redim YY (5 : Redim Jiax (5): Redim JiaY (5) 'To implement multi-thread, initial thread storage array for i = 0 to 4randomizExx (i) = Wid * rnd: yy (i) = hei * rndnext: p.drawWidth = 1case 21: p.drawidth = 3case 22: RectMax = Round (rND * 50): p.drawidth = 1case 23: p.FONTSIZE = 12: P.FontBold = true: hang = 1case 26: p.FONTSIZE = 12: P .Fontbold = truecase 27redim xx (5): Redim YY (5): Redim Jiax (5): Redim J IAY (5) for i = 0 to 4randomizexx (i) = wid * rnd: yy (i) = hei * rndnext: p.drawWidth = 1: P.backcolor = vbbbcase 29: p.drawidth = 50case 31: Redim xx ( 5): Redim YY (5): Redim jiax (5) xx (0) = wid * rnd: yy (0) = hei * rnd: p.drawWidth = 1case 33: p.drawidth = 5case 34: p.drawidth = 1case 37: p.FillStyle = 0: p.drawidth = 2case elsep.drawidth = 1nd selectxiaoguo = index: timer1.enabled = true 'Start running player End Sub

Private Sub Form_Load () xiaoguo = 0: P.backcolor = vbwhite: bcolor = vbwhitefor i = 0 to 2: ColorStart (i) = Round (rND * 255): NEXT 'Start Generating three random primary color End Sub Private Sub Form_Resize () 'Forms movement When the control layout and some parameters are set on Error ResMe nextp.width = me.scalewidth - 200: frame1.top = me.scaleHeight - frame1.height - 100p.Height = frame1.top - 100IF me. Scalewidth> frame1.width thenframe1.TOP = p.Width / 2nd IFTH / 2 - FRAME1.WIDTH / 2END IFS.TOP = P.TOP P.HEIGHT - S.HEIGHTWID = P.Width: hei = p.Heightend Sub

Private sub menu01_click (index as integer) 'Control Menu Click Select Case Indexcase 1: Timer1.Enabled = Not Timer1.Enabled' Play / Stop Case 2: 'Next Effect If Xiaoguo = Command1.count - 1 THEN Xiaoguo = 0 else xiaoguo = xiaoguo 1Command1_click xiaoguocase 3: 'Next color force for i = 0 to option1.count - 1IF option1 (i) .Value = true kil = option - 1 THEN OPTION1 (0) .Value = true else Option1 (i 1) .value = truecase 4: 'Setting up background str1 = INPUTBOX ("Please enter a color code," & H Blue Green Red "color, primary color parameter 00-ff", " Background setting ", HEX (P.BackColor)) if str1 =" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" " ! ", Vbcritical," error parameters ": p.backcolor = OldColorbColor = P.BackColorcase 5: P. Cls 'Clear Canvas Case 6: S.Visible = not s.visible' Show / Hide Speed ​​Control Case 8: Save Canvas Graphics for image if INSTR (app.path, "/") = len (app.path) THEN PATH1 = app.path else path1 = app.path & "savepicture P.Image, Path1 & "Effect Picture" & Xiaoguo & ".jpg" Path2 = "File: ///" & Replace (Path1 & "effect picture" & xiaoguo & ".jpg", "/", "/" ) Shell "explorer" & path2, vbMaximizedFocus' ignorance why not functioning End SelectEnd SubPrivate Sub p_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu menu1 browser at WIN2003 'Pop-up menu end sub

PRIVATE SUB S_CHANGE () 'Speed ​​up or slow down Timer1.Interval = S.ValueEnd Sub

PRIVATE SUB OPTION1_CLICK (INDEX AS INTEGER) 'Color effect radio button array Click coloris = indexend subprivate sub timer1_timer () playback cyclic timer start running, the following 39 effect algorithms have not been examined carefully, it can be optimized Randomizeselect Case Coloriscase 0 'Applied Random Arbitrary Color1 = RGB (Round (Round * 255), Round (RND * 255), Round (RND * 255)) Case 1' App RAPTION Folous FOR I = 0 To 2IF ColorStart (i )> 254 THEN ColorStart (i) = Round (RND * 255) Else ColorStart (i) = ColorStart (i) 1NEXTCOLOR1 = RGB (ColorStart (0), ColorStart (1), ColorStart (2)) Case 2 'App RAP Gradient for i = 0 to 2if ColorStart (i) <1 THEN Colorstart (i) = Round (RND * 255) Else ColorStart (i) = ColorStart (i) - 1NEXTCOLOR1 = RGB (ColorStart (0), ColorStart (1 ), colorstart (2)) Case 3 'contrast black and white colors If heibai = False ThenIf heibaicolor> 254 Then heibai = True Else heibaicolor = heibaicolor 1ElseIf heibaicolor <1 Then heibai = False Else heibaicolor = heibaicolor - 1End Ifcolor1 = RGB (heibaicolor, heibaicolor Heibaicolor) Case 4 'black and white gradual color IF Heibaic olor> 254 Then heibaicolor = Round (Rnd * 255) Else heibaicolor = heibaicolor 1color1 = RGB (heibaicolor, heibaicolor, heibaicolor) Case 5 'Among getting color concentrate If heibaicolor <1 Then heibaicolor = Round (Rnd * 255) Else heibaicolor = Heibaicolor - 1Color1 = RGB (Heibaicolor, Heibaicolor, Heibaicolor) End SELECT

SELECT CASE XIAOGUOSE 0 'Horizontal Line RND1 = ROUND (RND * HEI) P.LINE (0, RND1) - (WID, RND1), Color1Case 1' Vertical Line RND1 = ROUND (RND * WID) P.LINE (RND1, 0) - (RND1, HEI), color1case 2 'Right to Right to Radiation P.LINE (0, 0) - (Round (RND * WID), Round (RND * HEI)), Color1Case 3' intensive radiation RND1 = Round (RND * WID): RND2 = ROUND (RND * HEI) p.Line (0, 0) - (RND1, RND2), Color1p.Line (0, HEI) - (RND1, RND2), Color1p.Line (WID, 0) - (RND1, RND2), Color1p.Line (WID, HEI) - (RND1, RND2), Color1Case 4 'internal diffusion P.Line (WiD / 2, HEI / 2) - (Wid * RND, HEI * RND), Color1Case 5 'left and right extensions IF POS1 * 2 0 THEN' If it is odd, the right extension, otherwise to left p.Line (WiD / 2 POS1, 0) - (WID / 2 POS1, HEI), Color1ELSEP.LINE (WiD / 2 - POS1, 0) - (WID / 2 - POS1, HEI), Color1end IFCase 6 'Random Segment RND1 = WID * RND: RND2 = HEI * RNDRND3 = RND * 1000: IF RND3 <500 THEN RND3 = -rnd3rnd4 = RND * 1000: IF RND4 <500 Then RND4 = -rnd4for i = 0 to 3: p.Line (RND1, RND2) - (RND1 RND3 , RND2 RND4), Color1: Nextcase 7 'Random Particle for i = 0 to 3: P. Pset (Wid * RND, HEI * RND), Color1: Nextcase 8 'Virtual Hulu RND1 = Wid * RND: RND2 = HEI * RNDFOR I = 0 to 5TEMP1 = 8 (i * 3) P.drawWidth = Temp1p.pset RND1 (Temp1 * 6 * I), RND2 (Temp1 * 6 * i)), Color1Nextcase 9 '3D cross wid1 = WID / 2: hei1 = hei / 2if Pos1 * 2

POS1), Color1ELSEP.LINE (Wid1 - POS1, 0) - (Wid1 - POS1, HEI), Color1p.Line (0, Hei1 - Pos1) - (WID, Hei1 - Pos1), Color1end IFCase 10 'X Auro IF POS1 * 2 Hei Then Lihe = Falseif Pos1 < 25 THEN LIHE = Trueif Lihe = False Then POS1 = POS1 - 20 ELSE POS1 = POS1 20P.LINE (0, 0 POS1) - (WID, 0 POS1), Color1p.Line (Wid, Hei - POS1) - ( 0, HEI - POS1), Color1Case 13 'Fallen Angel IF POS1 HEI / 2 TEN 'Draw Volcanic POS2 = POS1ELSEP.LINE (Wid1 - 800, HEI) - (WID1, HEI - 500), Color1p.Line - (WiD1 800, HEI), Color1END IFPOS2 = POS2 1: P. PSET (Wid1 (POS2 * (RD - 0.5)), HEI - 500 - (POS2 * (RND 0.4))), Color1P.Pset (WiD1 (POS1 * (RND - 0.5)), HEI - 500 - POS1 * (RND 0.4))))

WID * RND: RND2 = HEI * RNDP.LINE (RND1, HEI POS1) - (RND1, HEI POS1 - (RND * 500)), Color1p.Line (RND1, RND2) - (RND1, RND2 (RND * 500)), P.Backcolorcase 16 '光 之 光 i POS1 <300 THEN POS1 = POS1 15 ELSE POS1 = 0: IF POS2 <299 THEN POS2 = 300WID1 = WID / 2: Hei1 = HEI / 2P.LINE (POS1, POS1) - (WID - POS1, HEI - POS1), Color1, Bif Pos2 <299 Thenp.circle (WiD1, Hei1), POS1, Color1,,, 1ELSEPOS2 = POS2 15IF POS2> HEI THEN POS2 = 0: POS1 = 0 : p. clsp.circle (Wid1, Hei1), POS2, Color1,, 1END IFCase 17 'growth Decline WID1 = WID / 2: HEI1 = HEI / 2IF POS1> Hei1 Then Lihe = Falseif Pos1 <10 Then Lihe = Trueif Lihe = False kilmcle (wid1, hei1), POS1, P.BACKCOLORPOS1 = POS1 - 10ELSEPOS1 = POS1 10P.CIRCLE (WID1, HEI1), POS1, Color1,, ABS (RND 0.5) End IFCase 18 'Light Collection wid1 = WID / 2: HEI1 = HEI / 2: RND1 = RND * 200 IF POS1 WID / 2 THEN POS2 = POS2 20: P.Circle (WiD1, Hei1) , POS2, Color1,, RNDCase 19 'life reproduction P.CLS: POS1 = POS1 1IF POS1 MOD 50 = 0 And Ubound (xx) <500 TenTemp1 = Ubound (xx) 1redim preserve XX (TEMP1): Redim Preserve YY (TEMP1) Redim Preserve Jiax (Temp1): Redim Preserve JiaY (TEMP1) XX (Temp1) = Wid * Rnd: YY (TEMP1) = HEI * Rndend IFOR I = 0 to Ubound (xx) IF Hei - YY (i) < 150 Then JiaY (i) =

Falseif Wid - XX (I) <150 Then Jiax (i) = falseif yy (i) <150 Then JiaY (i) = TRUEIF XX (I) <150 Then Jiax (i) = Trueif Jiay (i) = True Then YY (i) = yy (i) 50 else yy (i) = yy (i) - 50IF jiax (i) = true kil (i) = xx (i) 50 else xx (i) = xx (i) - 50p.circle (xx (i), yy (i)), 200, Color1Nextcase 20 'dropped IF POS1 <20 Then Lihe = Trueif Pos1> Hei - 2500 Then Lihe = falseif Lihe = false the pos1 = POS1 - 30 ELSE POS1 = POS1 30P.Clswid1 = WID / 2: HEI1 = HEI / 2P.Line (Wid1 - 800, HEI - 500) - (WID1 800, HEI), Color1, Bfp.circle (WiD1, Hei - 1500 - POS1), 1000, -COLOR1,, 1CASE 21 '3D Space WID1 = WID / 2: HEI1 = HEI / 2IF POS1 = (RectMax / 2) Then POS2 = 0: p.cls: RectMax = Round (RND * 30) 1Rnd1 = Wid / RectMax: RND2 = HEI / (RectMax / 2) IF POS1 <= RectMax Then POS1 = POS1 1 ELSE POS1 = 0: POS2 = POS2 1P.LINE (RND1 - RND1 * POS1, RND2 * POS2) - (RND1 * POS1, RND2 * POS2 RND2), Color1, BCase 23 'Modern Speech Str1 = "Destiny is like a universe star, it is so tangible, the soul has passed many times, it is already scar Tired, "& _" Although it is stripped into dazzling beauty, but it is the courageous, it will not tear into tears, it is only useful to "& _" to fill, just like hunger Only food is only satisfied, it is too terrible too tempting, no one is your true loved ones, there is no selfless existence, there is no true love, no true love,

In short, there is a virtual virtual only, it is true, only the wind is your true "& _" relative, only the sun is really selfless. .

"IF 100 * rND> 20 THEN EXIT SUBP.FORECOLOR = Color1if Pos1 Hei / 10 Then Lihe = Falseif Pos1 <20 THEN LIHE = TRUEIF Lihe = True Tenpos1 = POS1 10: col1 = color1: col2 = -color11elsepos1 = POS1 - 10: color1 = -color1: col2 = color1nd ifp.cls: wid1 = wid / 2: hei1 = hei / 2Temp1 = HEI / 3 - POS1P.CIRCLE (WID1 , HEI1 - (Temp1 / 3) (POS1 * 3.5)), TEMP1, COL1, POS1 / (HEI / 10) P.circle (WiD1, Hei1 (Temp1 / 3) - (POS1 * 3.5)), Temp1, col2 ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, LINE (0, 0) - (WID, POS1), Color1p.Line (0, HEI) - (WID, HEI - POS1), Color1p.Line (WiD, 0 ) - (0, POS1), Color1case 26 'rolling desk word STR1 = "Fish lost the pond, mosquito is sleepy in the spider web, the traces that can't escape, weak struggle, although" static " "& _" Gives me the lost, let me go, but the heart is really too tired, after a pain, the soul of the soul can not "& _" healing | I have chosen to sleep, Playing the game escapes all the pain, but don't forget to "last", I don't know how many times, "the last", "& _" escape, and it is more difficult to endure what they do, self-blaming, and even a coward. Evil prisoners, but the liberation of the temptation finally did not "& _" to try, the most neurine, I have chosen to continue depression and bravely, this choice is a "IF POS1

10 ELSE POS1 = 1: POS2 = 0p.cls: p.forecolor = color1if POS2 = 0 TEN 'calculates the number of commas, in order to increase the scroll time limit I = 1WHILE INSTR (I, STR1, ") <> 0Temp1 = INSTR I, STR1, ",") POS2 = POS2 1: I = Temp1 1Wendend IFP.CURRENTY = HEI - POS1: P.Print Replace (Replace (STR1, ",", VBCRLF), "|", VBCRLF & VBCRLF ) Case 27 'Night Sky Meteor P.Clsif Ubound (XX) <200 TENTEMP1 = Ubound (XX) 1: Redim Preserve XX (Temp1): Redim Preserve YY (TEMP1) Redim Preserve Jiax (Temp1): Redim Preserve Jiay (TEMP1) XX (TEMP1) = Wid * RND: YY (TEMP1) = HEI * RNDEND IFOR I = 0 to Ubound (YY) IF YY (i)> HEI 500 Then YY (i) = 0iF xx (i) <-500 Then XX (I) = WID * RND Heiyy (i) = yy (i) 30: XX (i) = xx (i) - 30p.Line (xx (i), yy (i)) - (xx (i 500, YY (I) - 500), Color1NextCase 28 'Random Deformation IF 100 * RND <80 THEN EXIT SUBWID1 = WID / 2: HEI1 = HEI / 2: RND1 = ROUND (RND * 3) 1: P. CLSFOR I = 0 TO RND1IF I = 0 THENP.LINE (WID1 - 500, HEI1 - 500) - (WiD1 500, HEI1 - 500), Color1ELSEIF I = RND1 TENP.LINE - (WiD1 500, HEI1 500), Color1p.Line - (WiD1 - 500, HEI1 500 ), Color1: p.Line - (Wid1 - 500, Hei1 - 500), Color1ELSEP.LINE - (Wid * RND, Hei * RND), Color Lear1end Ifnextcase 29 'Tianwi 1 = WID1 = WID / 2: HEI1 = HEI / 2IF POS1 = 0 THENP.CLSFOR I = 1 to 20p.circle (Wid1, HEI1), HEI1 / 1.5 - (i * (HEI1 / 32)), Color1Nextend IFIF POS1> WID1 / 2 THEN POS1 = 0 else POS1 = POS1 20p.circle (Wid1 - (HEI1 / 1.7), HEI - (HEI1 / 1.7)), POS1, P.BACKCOLORCASE 30 'Rotary Light POS1 = POS1 5: WID1 = WID / 2: P.Clsif Pos2> = Wid1 Then POS1 =

0: POS2 = 0if POS1 MOD 600 = 0 Thenlihe = falseelseif Pos1 mod 300 = 0 THENLIHE = TrueEnd ifif Lihe = FALSE THEN POS2 = POS2 ((POS1 / 250) * 10) Else Pos2 = POS2 - ((POS1 / 250) * 10) P.Line (Wid1 - POS2, 0) - (Wid1 - POS2, HEI), Color1p.Line (Wid1 POS2, 0) - (Wid1 POS2, HEI), -Color1Case 31 'Light Track IF XX (0) <500 Then Jiax (0) = Trueif YY (0) <500 Then JiaY (0) = Trueif WID - XX (0) <500 Then Jiax (0) = falseif Hei - YY (0) <500 Then Jiay (0) = falseif jiax (i) = true kil (0) = xx (0) 500 else xx (0) = xx (0) - 500IF JIAY (i) = true dam yy (0) = yy (0) ) 500 else yy (0) = yy (0) - 500IF lihe = false tw.Line (xx (0), yy (0)) - (xx (0), yy (0)), color1lihe = trueelsep.Line - (xx (0), yy (0)), Color1END IFCase 32 'Rotating Memolive IF INSTR (app.path, "/") = len (app.path) THEN PATH1 = app.path else path1 = app.path & "/" str1 = path1 & "甩 brother .jpg" set pic1 = loadPicture (str1): p.cls: wid1 = wid / 2: hei1 = hei / 2if POS1

WID1 - (Wid1 - Hei1) THEN POS1 = POS1 30 ELSE POS1 = 1: POS2 = 0: P.CLS: EXIT SUBFOR I = 0 to Pos1 Step Pos2i = i POS2P.PSET (i * COS (i) WID1 , i * sin (i) hei1), color1nextcase 34 'Akimi two wid1 = wid / 2: hei1 = HEI / 2: if Pos1