[ VB.NET ] Heart Bubbles

تم تحميل الصفحة في 1,2411174 ثانية
Heart Bubbles

QS7S

مُميّز نُقطة لُغات البرمجة للعام 2019
rankrank
إنضم
28 يناير 2019
المشاركات
292
الإعجابات
354
النقاط
63
السلام عليكم ورحمة الله وبركاته




Class HeartBubbles


كود:
Public Class HeartBubbles
    Inherits Control
    Sub New()
        SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.UserPaint Or
        ControlStyles.ResizeRedraw Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.SupportsTransparentBackColor, True)
        Me.DoubleBuffered = True
        Me.Size = New System.Drawing.Size(100, 400)
        Me.BackColor = Color.Transparent
    End Sub
    Enum Bubble As Byte
        Slow = 0
        Fast = 1
    End Enum
    Public Shared Sync As Object = New Object()
    Public Sub Add()
        Add(Bubble.Slow, Nothing, Nothing)
    End Sub
    Public Sub Add(ByVal BubbleMode As Bubble, ByVal FillColor As Object, ByVal ColorBorder As Object)
        Dim c0, c1 As Object
        If FillColor Is Nothing Then
            Dim r As New Random
            c0 = Color.FromArgb(r.Next(255), r.Next(255), r.Next(255))
        Else
            c0 = FillColor
        End If
        If ColorBorder IsNot Nothing Then
            c1 = ColorBorder
        Else
            c1 = Nothing
        End If
        Dim v0, v1, v2 As Integer
        v0 = 17
        v1 = 26
        v2 = 3
        SyncLock Sync
            hearts.Add({c0, 245, CInt(Me.Width / 2) + rndm(3, 20), Me.Height - v1 + 10, v2, rndm(10, Me.Width - 10), -1, BubbleMode, v0, v1, c1})
        End SyncLock
        If Systimer0 Is Nothing Then
            Systimer0 = New System.Timers.Timer
            AddHandler Systimer0.Elapsed, AddressOf OnTimedEvent0
            Systimer0.Interval = 1
            Systimer0.AutoReset = True
        End If
        If Systimer0 IsNot Nothing Then
            If Systimer0.Enabled = False Then
                EnableTimer0()
            End If
        End If
    End Sub
    Private hearts As New List(Of Object)
    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        Dim G As Graphics = e.Graphics
        With G
            .SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
            .PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
            If hearts.Count > 0 Then
                For Each i In hearts
                    Dim x As Object() = i
                    If x(4) >= x(8) And x(6) = 1 Then
                        x(4) = x(4) - 1
                        x(2) = x(2) + 1
                    ElseIf x(4) < x(9) And x(6) = -1 Then
                        x(4) = x(4) + 3
                        x(2) = x(2) - 1
                    Else
                        If x(4) >= x(9) And x(6) = -1 Then
                            x(6) = 1
                        Else
                            If x(6) = 1 Then
                                x(6) = 966
                            End If
                        End If
                    End If
                    Dim s As Integer = CInt(x(4))
                    Dim gp As Drawing2D.GraphicsPath = hGP(New Point(2, 2), New Point(s, s))
                    Using bm As New Bitmap(s + 12, s + 12)
                        Using gr As Graphics = Graphics.FromImage(bm)
                            gr.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
                            gr.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
                            If x(1) > 0 Then
                                x(1) = x(1) - If(x(7) > 1, 3, 1)
                            End If
                            gr.FillPath(New SolidBrush(Color.FromArgb(CInt(x(1)), x(0).R, x(0).G, x(0).B)), gp)
                            If x(10) = Nothing Then
                                gr.DrawPath(New Pen(Color.FromArgb(CInt(x(1)), x(0).R, x(0).G, x(0).B), 1.6F), gp)
                            Else
                                gr.DrawPath(New Pen(Color.FromArgb(CInt(x(1)), x(10).R, x(10).G, x(10).B), 1.6F), gp)
                            End If
                            gr.Dispose()
                        End Using
                        Select Case DirectCast(x(7), Bubble)
                            Case Bubble.Slow
                                x(3) = x(3) - 1
                            Case Bubble.Fast
                                x(3) = x(3) - 2
                        End Select
                        .DrawImage(bm.Clone(), x(2), x(3))
                        bm.Dispose()
                    End Using
                    gp.CloseAllFigures()
                Next
                Dim rm As Object() = (From a As Object In hearts Select a Where a(1) <= 0).ToArray
                If rm.Count > 0 Then
                    For Each i In rm
                        SyncLock Sync
                            hearts.Remove(i)
                        End SyncLock
                    Next
                End If
            End If
        End With
    End Sub
    Private Function rndm(ByVal v0 As Integer, ByVal v1 As Integer) As Integer
        Dim r As Random = New Random()
        Return r.Next(v0, v1)
    End Function
    Private Function hGP(poi0 As Point, poi1 As Point) As Drawing2D.GraphicsPath
        Dim w As Integer = Math.Max(poi1.X, poi0.X) - Math.Min(poi1.X, poi0.X)
        Dim h As Integer = Math.Max(poi1.Y, poi0.Y) - Math.Min(poi1.Y, poi0.Y)
        Dim a As Integer = CInt((w + h) / 2)
        Dim hPath As New Drawing2D.GraphicsPath(Drawing2D.FillMode.Winding)
        If a > 0 Then
            Dim tlc As Point = poi0
            If poi1.X < poi0.X Then
                tlc.X = poi1.X
            End If
            If poi1.Y < poi0.Y Then
                tlc.Y = poi1.Y
            End If
            Dim r As Integer = CInt(a / 2)
            Dim y As Int32 = CInt(tlc.Y + r / 2 + Math.Sin(45 / 180 * Math.PI) * r / 2) + (r - (1 - Math.Sin(45 / 180 * Math.PI)) * r / 2)
            hPath.AddArc(tlc.X, tlc.Y, r, r, 135.0F, 225.0F)
            hPath.AddArc(tlc.X + r, tlc.Y, r, r, 180.0F, 225.0F)
            hPath.AddLine(CInt(tlc.X + a - (1 - Math.Sin(45 / 180 * Math.PI)) * r / 2), CInt(tlc.Y + r / 2 + Math.Sin(45 / 180 * Math.PI) * r / 2), tlc.X + r, y)
            hPath.CloseFigure()
        End If
        Return hPath
    End Function
    Private Systimer0 As System.Timers.Timer = Nothing
    Private Sub DisableTimer0()
        If Systimer0 IsNot Nothing Then
            Systimer0.Stop()
            Systimer0.Enabled = False
        End If
    End Sub
    Private Sub EnableTimer0()
        Systimer0.Enabled = True
    End Sub
    Private Sub OnTimedEvent0(source As Object, e As Timers.ElapsedEventArgs)
        If hearts.Count = 0 Then
            DisableTimer0()
            Me.Invalidate()
        Else
            Me.Invalidate()
        End If
    End Sub
End Class

طريقة الاستخدام

ضع الأداة في احد زوايا البرنامج

ثم اضافة قلب

كود:
  HeartBubbles1.Add()
او

كود:
HeartBubbles1.Add(HeartBubbles.Bubble.Fast, Color.HotPink, Nothing)
'HeartBubbles1.Add(لون الحدود, لون القلب, سرعة ارتفاع القلب)

vb.SRC
 

Ahmed Al'jabari

إداري أقسام البرمجة
rankrankrankrank
إنضم
24 يونيو 2017
المشاركات
1,611
الإعجابات
1,318
النقاط
123
الإقامة
Turkey
جميله الحركه

الحين بيستغلونها الهكرطيه ويضعون جماجم يعني اثبات بأنهم ناس خطيرين .

الفكره جميله .
هههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههههه مشكله والله
 
الإعجابات: QS7S

QS7S

مُميّز نُقطة لُغات البرمجة للعام 2019
rankrank
إنضم
28 يناير 2019
المشاركات
292
الإعجابات
354
النقاط
63
هههههههههه ياخي من وين تجيك هاي الافكار :257:
هاذي الأداة تفيد في الإعجابات بالبث المباشر
الفكرة من تطبيق bigo live
اسعدني مرورك

جميله الحركه

الحين بيستغلونها الهكرطيه ويضعون جماجم يعني اثبات بأنهم ناس خطيرين .

الفكره جميله .
ههههههههههاااااي موتني ضحك .. وانت اجمل

والله فكرة مميزة جدا
شكرا لك علي هذه الفكرة
لا داعي للشكر , على الرحب والسعة :32::32:
 
الإعجابات: MaxXx

الأعضاء النشطين حاليآ الذين يشاهدون هذا الموضوع (1 عضو و 2 ضيف)

خيارات الاستايل

نوع الخط
مودك
اخفاء السايدر بار OFF
توسيط المنتدى OFF
فصل الأقسام OFF
الأقسام الفرعية OFF
عرض المشاركات
حجم الخط
معلومات العضو OFF
إخفاء التوقيع OFF

إرجاع خيارات الإستايل