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

好了,看看效果吧,赶紧表白吧。哈哈

时间: 2024-10-07 07:29:11

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

大学生程序员情书“2014爱的告白挑战赛”

大学生程序员情书"2014爱的告白挑战赛" 活动时间: 2014.09.29 - 2014.10.31 参与条件: CSDN高校俱乐部注册在校大学生  还不是会员,立即注册-> 参与方法: 参与学生须需在线提交爱情告白书,在IT术语文本.三行代码.搞笑另类情书三种形式中任选其一. 情书需为本人原创,抄袭者经举报后取消获奖资格.情书内容健康.有内涵,文本形式必须包含6个以上不重复IT术语:三行代码情书不限制开发语言种类,请在每行添加注释以便参与评选. 每个人只能选择一种告白形式.重

PHP笔记——java程序员看懂PHP程序

PHP笔记——java程序员看懂PHP程序 php是一种服务器端脚本语言,类型松散的语言. <?php   ?>       xml风格 <script language=”php”></script>   脚本风格 <?       ?>    简短风格 <%              %>    ASP风格 以;结尾: 注释: a)         // b)         # c)         /*     */ 变量是存储数据的容器

程序员自我提高的几点建议 很实诚(转)

一.背景 中国程序员的成长是与其学习环境相关,据统计,现时做计算机软件开发的人员65%是大专及本科学历,15%是来自于其他的培训机构.可见一个开发人员大致的学习经历和初步经验来自于大学. 而在印度,韩国,以及欧美一些软件外包相对发达的国家大部分是采用中专学员,他们从中学阶段即接受最为严谨,最为科学的软件工程培训.一般,大学毕业生后也会从事编码工作,但工作一至两年后即往系统分析师,架构师发展. 二.程序员自我提高的几点建议 下面的几点建议还算比较实诚,关键看你的执行力. 1.提高文档编写能力 误区

好程序员Java教程Java动态代理机制详解

好程序员Java教程Java动态代理机制详解:在java的动态代理机制中,有两个重要的类或接口,一个是 InvocationHandler(Interface).另一个则是 Proxy(Class),这一个类和接口是实现我们动态代理所必须用到的.首先我们先来看看java的API帮助文档是怎么样对这两个类进行描述的: InvocationHandler: 1InvocationHandler is the interface implemented by the invocation handle

从程序员到项目经理(5):程序员加油站 -- 懂电脑更要懂人脑

说 起程序员三个字,我觉得既骄傲又可悲.骄傲的是,我们曾经是时代骄子,是一群真正改变世界的人:可悲的是,我们很多致力于改变世界的程序员,却生活在自己 的世界里,无法自拔,成为了继“书呆子”之后的“电脑呆子”.电脑本来只是一个工具,我们竟然被其所限制.甚至同化,悲夫!一.警惕成为“电脑呆子”(1)程序员眼中的自己程序员是怎样看待自己的呢?看看园子里的发言,码农.码畜.IT民工.苦逼.程序猿…这样的字眼俯拾皆是.在网上曾经广泛流传一首关于程序员的诗,模仿的是唐伯虎的<桃花庵歌>,我们暂且称之为&l

程序员必需懂的黑化,飞升CTO就靠这个了

当前的程序猿世界"血雨腥风",如果不懂得黑话,不懂暗语,就很难在这江湖立足,今天,小编将和一起重温一下程序猿的黑话,是大鸟的可以跳过,是菜鸟的你必须要看...比你学会了<葵花宝典>的招式,不学点心法怎么行?身心合一方能立于不败之地 一,老板大BOSS的黑话 你来我办公室一下 == 老子又想到了绝妙的idea 得专注用户体验 == 界面画的好看点 产品气质不够年轻 == 饱和度通通调最高 产品气质不够成熟 == 界面通通做成黑的 产品不够大气 == 我也不知道哪不好反正就是不

只有程序员才能懂的幽默

乞丐 我是个程序猿,一天我坐在路边一边喝水一边苦苦检查bug.这时一个乞丐在我边上坐下了,开始要饭,我觉得可怜,就给了他1块钱,然后接着调试程序.他可能生意不好,就无聊的看看我在干什么,然后过了一会,他幽幽的说,这里少了个分号...分号...分号... 墓志铭 程序员,年二十有二,始从文,连考而不中. 遂习武,练武场上发一矢,中鼓吏,逐之出. 改学IT,自撰一函数,用之,堆栈溢出. 程序员进阶 程序猿的读书历程:x 语言入门 -> x 语言应用实践 -> x 语言高阶编程 -> x 语言

12款程序员们最爱的Bootstrap模板

如果你还没有开始使用Bootstrap模板,那你可真是有够OUT,这是一个帮助你快速开发的工具,Bootstrap是基于jQuery框架开发的,它在jQuery框架的基础上进行了更为个性化和人性化的完善,形成一套自己独有的网站风格,并兼容大部分jQuery插件.Bootstrap中包含了丰富的Web组件,根据这些组件,可以快速的搭建一个漂亮.功能完备的网站.其中包括以下组件:下拉菜单.按钮组.按钮下拉菜单.导航.导航条.面包屑.分页.排版.缩略图.警告对话框.进度条.媒体对象等. 今天我们带来的

找工作的程序员必懂的Linux

一.为什么要学习Linux 首先,我想先说一下:“为什么要学习Linux”?Linux 是什么,它是一款操作系统,是一个支持多用户.多任务.支持多线程和多CPU的操作系统:32位和64位的硬件可以在Linux 系统安全运行,是一个性能稳定的多用户网络操作系统.Linux 操作系统诞生在上世纪九十年代,可以安装在各种平板电脑.台式计算机和小型的树莓派上,从大到小的计算机硬件设备中都有Linux 的身影.Linux 这个词只表示Linux 内核,但人们习惯于用Linux 形容使用GNU工程各种工具和