首页 > 代码库 > VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦

VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦

先看看效果图吧:有动态绘制效果哦。

想不想知道怎么绘制的啊,别急,下面就直接给源码!

1界面设计。一个Form窗体,一个Panel控件,一个Button按钮。就这么简单。

代码:

'*********************************************************************     
'作者:章鱼哥,QQ:3107073263 群:309816713         
'如有疑问或好的建议请联系我,大家一起进步       
'*********************************************************************       
Imports Microsoft.VisualBasic.PowerPacks
Public Class Form1
    '定义一些全局变量
    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 Integer
    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) Handles MyBase.Load
        '生成圆形
        SetCircle()
        '初始化一些变量
        ini()

    End Sub
    '生成圆
    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
    '初始化变量
    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 ArrayList
        ArrayS.Clear()
        ArrayE.Clear()
        ArrayR.Clear()
        ArrayL.Clear()
        ind = 0
        Rin = 0
        PD = False
        indx = 0
        Lin = 0
        PDST = True
    End Sub
    '定时器1.绘制右半边直线群
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
      
        DrawRigth(Panel1, 4, CirD)

    End Sub
    '定时器2,绘制左半边直线群
    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        DrawingLeft(Panel1, -4, CirD)
    End Sub
    '定时器3,绘制心形的宽头
    Private Sub Timer3_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer3.Tick
        If Not PD Then
            Dim g As Graphics = Panel1.CreateGraphics
            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("我爱你", New Font("楷体", 40, 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 Sub
    '绘制心形右半边
    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
            For i = 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
    '绘制心形左半边
    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
            ArrayS.Add(New Point(0, CircleR))
            ArrayE.Add(New Point(CircleR, 0))
            g.DrawLine(Pens.Red, New Point(0, CircleR), New Point(CircleR, 0))
            For i = 0 To ArrayS.Count - 1
                ArrayL.Add(ArrayS(i))
            Next
            For i = 0 To ArrayE.Count - 1
                ArrayL.Add(ArrayE(i))
            Next
            ind = ArrayL.Count - 1
            Rin = (ArrayR.Count - 1) / 2
            Lin = ArrayL.Count - 1
            Timer3.Enabled = True
            Exit Sub
        End If
        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
        Dim 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) * (x1L - 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 If

        Next
        x1L += DrawingStep
    End Sub
    '绘制心形宽头
    Private Sub DrawingAll(ByVal ArrL As ArrayList, ByVal ArrR As ArrayList)
        Dim ind As Integer = ArrL.Count - 1
        Dim indx As Integer = 0
        For i = (ArrR.Count - 1) / 2 To ArrR.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 = Panel1.CreateGraphics
            g.DrawLine(Pens.Red, ArrL(i), ArrR(indx))
            indx += 2
        Next
    End Sub
    '开始绘制
    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
好了,看看效果吧,赶紧表白吧。哈哈

VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦