VB.net Octopus brother--programmers also understand love, dynamic draw hearts, very romantic OH

Source: Internet
Author: User

Let's take a look: there is a dynamic drawing effect oh.

Want to know how to draw ah, do not worry, the following directly to the source!

1 interface design. A form, a panel control, and a button. It's so simple.

Code:

' ********************************************************************* ' octopus brother, qq:3107073263 Group: 309816713 ' If in doubt or good Advice please contact me, everyone progress together ' ********************************************************************* Imports microsoft.visualb Asic.  Powerpackspublic Class Form1 ' defines some global variables Dim a_1_r As Double Dim a_1_l As Double Dim x1r As Double Dim x1l As  Double Dim y1r As Double Dim y1l As Double Dim x2r, x2l As Double Dim y2r, y2l As Double Dim ArrayS as New ArrayList Dim Arraye As New ArrayList Dim arrayl As New ArrayList Dim Arrayr As New ArrayList Dim ind As Inte  Ger Dim Rin As Integer Dim PD As Boolean = False Dim indx As Integer Dim Lin As Integer Dim PDST As Boolean = False Dim Cird as Double Private Sub Form1_Load (ByVal sender as System.Object, ByVal e as System.EventArgs) Handl        Es mybase.load ' Generate circular setcircle () ' Initialize some variable ini () End Sub ' generate Circle Private Sub setcircle () Dim Cir as NEW OvalShape Dim contain as New ShapeContainer contain.            Parent = Me.panel1 cir.parent = contain Dim Wid as Integer If panel1.width > Panel1.height Then            WID = panel1.height Else wid = panel1.width End If cird = Wid with Cir . Location = New Point (0, 0). Width = Wid. Height = Wid End With end Sub ' Initialize variable Private Sub ini () a_1_r = Cird a_1_l = Cird x1r = CIRD/2 x1l = cird/2 y1r = Cird y1l = Cird x2r = x2l = 0 y2r = y2l = 0 Dim ArrayS as New ArrayList Dim Arraye As New ArrayList Dim arrayl As New ArrayList Dim Arrayr As New Arr  Aylist arrays.clear () arraye.clear () arrayr.clear () arrayl.clear () ind = 0 Rin = 0 PD = False indx = 0 Lin = 0 PDST = True End Sub ' timer 1. Draw right half straight group Private Sub timer1_ Tick (ByVal sender as System.Object, ByVal e as System.EventArgs) Handles Timer1.tick drawrigth (Panel1, 4, Cird) End Sub ' Timer 2, draw left half straight group Private Sub Timer2_tick (ByVal sender as System.Object, ByVal e as System.EventArgs) Handles Timer2.tick Drawingleft (Panel1, -4, Cird) End Sub ' Timer 3, draw heart-shaped wide head Private Sub Timer3_tick (ByVal sender as Sy Stem. Object, ByVal e as System.EventArgs) Handles Timer3.tick If not PD then Dim g as Graphics = Panel1.creat Egraphics Using g.drawline (pens.red, Arrayr (Rin), Arrayl (Ind)) If Rin = arrayr.count-1 Or ind            <= 1 Then PD = True End If Rin + 1 IND-= 2 End using End If if PD then Dim gr as Graphics = Panel1.creategraphics Using gr. DrawLine (pens.red, Arrayl (Lin), Arrayr (indx)) If Lin = (arrayl.count-1)/2 or indx >= Arrayr.count-                  2 Then  timer3.enabled = False Dim g as Graphics = Panel1.creategraphics g.drawstring ("I Love You                ", New Font (" italics ", FontStyle.Bold, Brushes.deeppink, New Point (Cird * 1.5/5, CIRD/2)) Exit Sub End If indx + = 2 Lin-= 1 End Using End If End Su        B ' draw heart-shaped right half Private Sub drawrigth (ByVal drawingpanel as Panel, ByVal drawingstep as double, ByVal circled as Double)        Dim Circler As Double = Circled/2 Dim g As Graphics = drawingpanel.creategraphics A_1_r = Circled If Math.Abs (x1r-circled) < 0.2 Or y1r < circler then timer1.enabled = False g.drawline            (Pens.red, New Point (circled, Circler), New Point (Circler, 0)) Arrays.add (new Point (circled, Circler)) Arraye.add (new Point (Circler, 0)) For i = 0 to Arrays.count -1 Arrayr.add (ArrayS (i)) Next fori = 0 to arraye.count-1 arrayr.add (Arraye (i)) Next arraye.clear () ArrayS .            Clear () timer2.enabled = True Exit Sub End If if y1r < circled * 3/4 Then        Y1R-= Drawingstep x1r = math.sqrt (Circler * circler-(Y1r-circler) * (Y1r-circler)) + Circler Else y1r = math.sqrt (Circler * circler-(X1r-circler) * (X1r-circler)) + Circler End If Dim Stepnum as Double = 0.5 for i = Circler to 0 step-stepnum y2r = i x2r = math.sqrt (Circler * Circler-(Y2r-circler) * (Y2r-circler)) + Circler Dim A as Double = Math.Abs (Math.sqrt ((X1R-X2R) * (x1r            -X2R) + (Y1R-Y2R) * (Y1R-Y2R))-(CIRCLED/MATH.SQRT (2))) If a_1_r > A then a_1_r = a                Else Arrays.add (new Point (X1R, y1r)) Arraye.add (new Point (X2R, Y2R)) G.drawline (pens.red,New Point (X1R, y1r), New Point (X2R, Y2R)) Exit for End If Next x1r + = Drawingstep End Sub ' Draws a heart-shaped left half Private Sub drawingleft (ByVal drawingpanel as Panel, ByVal Drawingstep as Double, ByVal circled As double) Dim circler As Double = Circled/2 Dim g As Graphics = Drawingpanel.creategraphics A _1_l = Circled If Math.Abs (x1l) < 0.2 Or y1l < circler then timer2.enabled = False Arra Ys.add (new Point (0, Circler)) Arraye.add (new Point (Circler, 0)) G.drawline (pens.red, New Point (0, Ci Rcler), New Point (Circler, 0)) For i = 0 to arrays.count-1 arrayl.add (ArrayS (i)) Ne XT for i = 0 to arraye.count-1 arrayl.add (Arraye (i)) Next ind = ARRAYL.C            Ount-1 Rin = (arrayr.count-1)/2 Lin = arrayl.count-1 timer3.enabled = True Exit Sub End If y1l < circled * 3/4 then y1l + = Drawingstep x1l =-math.sqrt (Circler * Circler- (Y1l-circler) * (Y1l-circler)) + circler Else y1l = math.sqrt (Circler * circler-(x1l-circler) * (X1l-circler)) + circler End If ' y1l = math.sqrt (Circler * circler-(X1l-circler) * (X1l-circler)) + Circler Di  M stepnum as Double = 0.5 for i = Circler to 0 step-stepnum y2l = i x2l =-math.sqrt (circler * Circler-(Y2l-circler) * (Y2l-circler)) + Circler Dim A as Double = Math.Abs (Math.sqrt ((x1l-x2l) * (x 1L-X2L) + (y1l-y2l) * (Y1L-Y2L))-(CIRCLED/MATH.SQRT (2))) If a_1_l > A then a_1_l = A Else Arrays.add (new Point (x1l, y1l)) Arraye.add (new Point (x2l, y2l)        ) G.drawline (pens.red, New Point (x1l, y1l), New Point (x2l, y2l)) Exit for End IfNext x1l + = Drawingstep End Sub ' draw heart-shaped wide head Private Sub drawingall (ByVal ArrL as ArrayList, ByVal arrr as Arra Ylist) Dim ind As Integer = arrl.count-1 Dim indx As Integer = 0 for i = (arrr.count-1)/2 to Ar            Rr.count-1 Dim g as Graphics = Panel1.creategraphics g.drawline (pens.red, Arrr (i), ArrL (Ind)) IND-= 2 Next for i = Arrl.count-1 to (arrl.count-1)/2 Step-1 Dim g as Graphics = P Anel1.    CreateGraphics g.drawline (pens.red, ArrL (i), Arrr (indx)) indx + = 2 Next End Sub ' Start drawing        Private Sub Button_startr_click (ByVal sender as System.Object, ByVal e as System.EventArgs) Handles Button_startr.click INI () timer1.enabled = True End Sub End Class
OK, look at the effect, let's confess. Ha ha

VB.net Octopus brother--programmers also understand love, dynamic draw hearts, very romantic OH

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.