Xin chào các bạn, bài viết hôm nay mình chia sẻ các bạn source code tạo đội hình thi đấu bóng đá, có thêm di chuyển và sắp xếp đội hình trên VB.NET Winform.

[VB.NET] Line-ups Layout Football in Winform

Dưới đây là hình ảnh demo ứng dụng:

Các chức năng:

1. Tạo mới cầu thủ
2. Load danh sách cầu thủ
3. Lưu lại đội hình
4. Tải đội hình đã cài đặt
5. Chỉnh sửa di chuyển trực tiếp đội hình

Video demo ứng dụng:

Đầu tiên, các bạn tạo cho mình một usercontrol PlayerControl.vb

Source code VB:

Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Net.Http.Headers
Imports System.Windows.Forms
Imports System.Windows.Forms.Design
Imports System.Windows.Forms.VisualStyles.VisualStyleElement

Public Class PlayerControlData
    Public _textValue As String
    Public _textColor As Color
    Public _textFont As Font
    Public _namePlayerValue As String
    Public _namePlayerColor As Color
    Public _namePlayerFont As Font
    Public _backgroundColor As Color
    Public _borderColor As Color
    Public _borderWidth As Integer
    Public _size As Size
    Public _location As Point
    Public _urlAvatarImage As String

End Class
Public Class PlayerControl
    Inherits UserControl

    Private _textValue As String = "GK"
    Private _textColor As Color = Color.White
    Private _textFont As Font = Me.Font
    Private _namePlayerValue As String = "Player Name"
    Private _namePlayerColor As Color = Color.White
    Private _namePlayerFont As Font = Me.Font
    Private _backgroundColor As Color = ColorTranslator.FromHtml("#D00C0F")
    Private _borderColor As Color = Color.White
    Private _borderWidth As Integer = 4

    Private contextMenuNew As ContextMenuStrip
    Private editMenuItem As ToolStripMenuItem
    Private advEditMenuItem As ToolStripMenuItem
    Private removeMenuItem As ToolStripMenuItem
    Private _urlAvatarImage As String


    <Category("Appearance"), DisplayName("Choose Player Image")>
    <EditorAttribute(GetType(CustomFileBrowser), GetType(System.Drawing.Design.UITypeEditor))>
    Public Property AvatarPlayerImage() As String
        Get
            Return _urlAvatarImage
        End Get
        Set(ByVal value As String)
            _urlAvatarImage = value

            If String.IsNullOrEmpty(value) Then
                Me.Size = New Size(88, 80)
            Else
                Me.Size = New Size(120, 125)
            End If
            Invalidate()
        End Set
    End Property


    Public Property AvatarImage() As Image
        Get
            If String.IsNullOrEmpty(_urlAvatarImage) Then
                Return Nothing
            End If
            Return GetImageFromLocalDisk(_urlAvatarImage)
        End Get
        Set(value As Image)

        End Set

    End Property

    Public Function GetImageFromLocalDisk(filePath As String) As Image
        If filePath Is Nothing Then
            Return Nothing
        End If
        Dim image As Image = Image.FromFile(filePath)
        Return image
    End Function

    Public Sub New()
        SetStyle(ControlStyles.SupportsTransparentBackColor, True)
        BackColor = Color.Transparent
        Padding = New Padding(10, 5, 10, 25)
        If AvatarImage Is Nothing Then
            Me.Size = New Size(88, 80)
        Else
            Me.Size = New Size(120, 125)
        End If

        _namePlayerFont = New Font("Tahoma", 10, FontStyle.Regular)
        _textFont = New Font("Tahoma", 14, FontStyle.Bold)
        Me.Cursor = Cursors.Hand

        contextMenuNew = New ContextMenuStrip()
        editMenuItem = New ToolStripMenuItem("Edit")
        advEditMenuItem = New ToolStripMenuItem("Advance Edit")
        removeMenuItem = New ToolStripMenuItem("Remove")

        ' Add event handlers for menu items
        AddHandler editMenuItem.Click, AddressOf EditMenuItem_Click
        AddHandler advEditMenuItem.Click, AddressOf AdvEditMenuItem_Click
        AddHandler removeMenuItem.Click, AddressOf RemoveMenuItem_Click

        ' Add menu items to context menu
        contextMenuNew.Items.Add(editMenuItem)
        contextMenuNew.Items.Add(advEditMenuItem)
        contextMenuNew.Items.Add(removeMenuItem)

        ' Attach the context menu to the control
        Me.ContextMenuStrip = contextMenuNew
        Me.DoubleBuffered = True
    End Sub

    Public Function GetPlayerData() As PlayerControlData
        Dim userData As New PlayerControlData()
        userData._textValue = Me.TextValue
        userData._textColor = Me.TextColor
        userData._textFont = Me.TextFont
        userData._namePlayerValue = Me.NamePlayerValue
        userData._namePlayerColor = Me.NamePlayerColor
        userData._namePlayerFont = Me.NamePlayerFont
        userData._backgroundColor = Me.BackgroundColor
        userData._borderColor = Me.BorderColor
        userData._borderWidth = Me.BorderWidth
        userData._size = Me.Size
        userData._location = Me.Location
        userData._urlAvatarImage = Me.AvatarPlayerImage

        Return userData
    End Function

    Public Sub SetPlayerData(userData As PlayerControlData)

        Me.TextValue = userData._textValue
        Me.TextColor = userData._textColor
        Me.TextFont = userData._textFont
        Me.NamePlayerValue = userData._namePlayerValue
        Me.NamePlayerColor = userData._namePlayerColor
        Me.NamePlayerFont = userData._namePlayerFont
        Me.BackgroundColor = userData._backgroundColor
        Me.BorderColor = userData._borderColor
        Me.BorderWidth = userData._borderWidth
        Me.Size = userData._size
        Me.Location = userData._location
        Me.AvatarPlayerImage = userData._urlAvatarImage

    End Sub

    Public Event EditClicked As EventHandler

    Private Sub EditMenuItem_Click(sender As Object, e As EventArgs)
        ' Raise the EditClicked event
        RaiseEvent EditClicked(Me, EventArgs.Empty)
    End Sub

    Public Event AdvEditClicked As EventHandler

    Private Sub AdvEditMenuItem_Click(sender As Object, e As EventArgs)
        ' Raise the EditClicked event
        RaiseEvent AdvEditClicked(Me, EventArgs.Empty)
    End Sub


    Private Sub RemoveMenuItem_Click(sender As Object, e As EventArgs)
        Dim dlg = MessageBox.Show("Bạn muốn xóa player này?", "Thông báo", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
        If dlg = DialogResult.Yes Then
            Dim parentForm As Form = Me.FindForm()
            parentForm.Controls.Remove(Me)
        End If


    End Sub

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The main text value to display in the control.")>
    Public Property TextValue() As String
        Get
            Return _textValue
        End Get
        Set(ByVal value As String)
            _textValue = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The color of the main text.")>
    Public Property TextColor() As Color
        Get
            Return _textColor
        End Get
        Set(ByVal value As Color)
            _textColor = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The font of the main text.")>
    Public Property TextFont() As Font
        Get
            Return _textFont
        End Get
        Set(ByVal value As Font)
            _textFont = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The name player value to display below the circle.")>
    Public Property NamePlayerValue() As String
        Get
            Return _namePlayerValue
        End Get
        Set(ByVal value As String)
            _namePlayerValue = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The color of the name player text.")>
    Public Property NamePlayerColor() As Color
        Get
            Return _namePlayerColor
        End Get
        Set(ByVal value As Color)
            _namePlayerColor = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The font of the name player text.")>
    Public Property NamePlayerFont() As Font
        Get
            Return _namePlayerFont
        End Get
        Set(ByVal value As Font)
            _namePlayerFont = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The background color of the control.")>
    Public Property BackgroundColor() As Color
        Get
            Return _backgroundColor
        End Get
        Set(ByVal value As Color)
            _backgroundColor = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The color of the border.")>
    Public Property BorderColor() As Color
        Get
            Return _borderColor
        End Get
        Set(ByVal value As Color)
            _borderColor = value
            Invalidate()
        End Set
    End Property

    <Browsable(True)>
    <Category("Appearance")>
    <Description("The width of the border.")>
    Public Property BorderWidth() As Integer
        Get
            Return _borderWidth
        End Get
        Set(ByVal value As Integer)
            _borderWidth = value
            Invalidate()
        End Set
    End Property

    'Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
    '    MyBase.OnPaint(e)

    '    Dim g As Graphics = e.Graphics
    '    g.SmoothingMode = SmoothingMode.AntiAlias

    '    ' Calculate the available area for the circle, considering padding
    '    Dim availableWidth As Single = ClientSize.Width - Padding.Left - Padding.Right
    '    Dim availableHeight As Single = ClientSize.Height - Padding.Top - Padding.Bottom

    '    ' Calculate the diameter of the circle based on the available area
    '    Dim diameter As Single = Math.Min(availableWidth, availableHeight)

    '    ' Calculate the position of the circle based on padding
    '    Dim circleX As Single = Padding.Left + (availableWidth - diameter) / 2
    '    Dim circleY As Single = Padding.Top + (availableHeight - diameter) / 2

    '    ' Create a rectangle that represents the circle
    '    Dim circleRect As New RectangleF(circleX, circleY, diameter, diameter)

    '    ' Draw the background circle
    '    Dim backgroundBrush As New SolidBrush(_backgroundColor)
    '    g.FillEllipse(backgroundBrush, circleRect)

    '    ' Draw the border
    '    Dim borderPen As New Pen(_borderColor, _borderWidth)
    '    g.DrawEllipse(borderPen, circleRect)

    '    ' Draw the main text in the center of the circle
    '    Dim textBrush As New SolidBrush(_textColor)
    '    Dim format As New StringFormat()
    '    format.Alignment = StringAlignment.Center
    '    format.LineAlignment = StringAlignment.Center
    '    g.DrawString(_textValue, _textFont, textBrush, circleRect, format)


    '    textBrush.Color = _namePlayerColor
    '    ' Draw the name player text below the circle image
    '    Dim nameRect As New RectangleF(0, circleRect.Bottom + 5, ClientSize.Width, ClientSize.Height - circleRect.Bottom - 5)
    '    g.DrawString(_namePlayerValue, _namePlayerFont, textBrush, nameRect, format)
    'End Sub

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)

        Dim g As Graphics = e.Graphics
        g.SmoothingMode = SmoothingMode.AntiAlias
        Dim format As New StringFormat()
        format.Alignment = StringAlignment.Center
        format.LineAlignment = StringAlignment.Center
        ' Calculate the available area for the circle, considering padding
        Dim availableWidth As Single = ClientSize.Width - Padding.Left - Padding.Right
        Dim availableHeight As Single = ClientSize.Height - Padding.Top - Padding.Bottom

        ' Calculate the diameter of the circle based on the available area
        Dim diameter As Single = Math.Min(availableWidth, availableHeight)

        ' Calculate the position of the circle based on padding
        Dim circleX As Single = Padding.Left + (availableWidth - diameter) / 2
        Dim circleY As Single = Padding.Top + (availableHeight - diameter) / 2

        ' Create a rectangle that represents the circle
        Dim circleRect As New RectangleF(circleX, circleY, diameter, diameter)
        If String.IsNullOrEmpty(AvatarPlayerImage) Then


            ' Draw the background circle
            Dim backgroundBrush As New SolidBrush(_backgroundColor)
            g.FillEllipse(backgroundBrush, circleRect)

            ' Draw the border
            Dim borderPen As Pen
            If String.IsNullOrEmpty(AvatarPlayerImage) Then
                borderPen = New Pen(_borderColor, _borderWidth)
            Else
                borderPen = New Pen(Color.Transparent, _borderWidth)
            End If
            g.DrawEllipse(borderPen, circleRect)

            ' Draw the main text in the center of the circle
            Dim textBrush As New SolidBrush(_textColor)

            g.DrawString(_textValue, _textFont, textBrush, circleRect, format)

        End If

        Dim textBrush2 As New SolidBrush(_namePlayerColor)

        format.Alignment = StringAlignment.Center
        format.LineAlignment = StringAlignment.Center


        ' Draw the name player text below the circle image
        Dim nameRect As New RectangleF(0, circleRect.Bottom + 5, ClientSize.Width, ClientSize.Height - circleRect.Bottom - 5)
        g.DrawString(_namePlayerValue, _namePlayerFont, textBrush2, nameRect, format)

        ' Draw the avatar image
        If AvatarImage IsNot Nothing Then
            g.DrawImage(AvatarImage, circleRect)

        End If
    End Sub

    'Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
    '    MyBase.OnMouseDown(e)

    '    DoDragDrop(Me, DragDropEffects.Move)
    'End Sub

    Private mdLoc As Point

    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        MyBase.OnMouseDown(e)
        mdLoc = e.Location
    End Sub

    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
        MyBase.OnMouseMove(e)
        If e.Button = MouseButtons.Left Then
            Me.Left += e.X - mdLoc.X
            Me.Top += e.Y - mdLoc.Y
        End If
    End Sub



End Class
Public Class CustomFileBrowser
    Inherits FileNameEditor

    Protected Overrides Sub InitializeDialog(ByVal openFileDialog As OpenFileDialog)
        MyBase.InitializeDialog(openFileDialog)
        openFileDialog.Title = "Select Player Image: "
        openFileDialog.Filter = "Image File (*.png)|*.png"
    End Sub
End Class

Tiếp đến là source code ở Form1.vb chứa hình ảnh sân bóng và sắp xếp đội hình

Imports System.IO
Imports System.Reflection
Imports System.Threading
Imports Newtonsoft.Json

Public Class Form1
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.DoubleBuffered = True

    End Sub

    Private Sub menu_save_Click(sender As Object, e As EventArgs) Handles menu_save.Click


        Dim saveFileDialog As New SaveFileDialog()
        saveFileDialog.RestoreDirectory = True
        saveFileDialog.FileName = "mylayout.layout"
        saveFileDialog.Filter = "Layout Files (*.layout)|*.layout|All Files (*.*)|*.*"
        saveFileDialog.FilterIndex = 1

        Dim result As DialogResult = saveFileDialog.ShowDialog()

        If result = DialogResult.OK Then

            Dim selectedFileName As String = saveFileDialog.FileName
            Dim listData = New List(Of PlayerControlData)
            For Each control As Control In Me.Controls
                If TypeOf control Is PlayerControl Then
                    Dim pictureBox As PlayerControlData = DirectCast(control, PlayerControl).GetPlayerData()
                    listData.Add(pictureBox)
                End If
            Next

            Dim jsonData = JsonConvert.SerializeObject(listData)
            File.WriteAllText(saveFileDialog.FileName, jsonData)
            MessageBox.Show("Save Layout Successful.")

        End If
    End Sub



    Private Sub menu_open_Click(sender As Object, e As EventArgs) Handles menu_open.Click
        Dim openFileDialog As New OpenFileDialog()
        openFileDialog.RestoreDirectory = True
        openFileDialog.Filter = "Layout Files (*.layout)|*.layout|All Files (*.*)|*.*"
        openFileDialog.FilterIndex = 1
        Dim result As DialogResult = openFileDialog.ShowDialog()

        If result = DialogResult.OK Then
            Dim selectedFileName As String = openFileDialog.FileName
            Dim rawData = File.ReadAllText(selectedFileName)
            Dim listData = JsonConvert.DeserializeObject(Of List(Of PlayerControlData))(rawData)
            ClearAllPlayer()
            For Each item As PlayerControlData In listData
                Dim itemPlayer = New PlayerControl()
                itemPlayer.SetPlayerData(item)
                AddHandler itemPlayer.EditClicked, AddressOf CircularTextControl_EditClicked
                AddHandler itemPlayer.AdvEditClicked, AddressOf AdvCircularTextControl_EditClicked
                Me.Controls.Add(itemPlayer)
            Next

        End If
    End Sub

    Private Sub menu_add_Click(sender As Object, e As EventArgs) Handles menu_add.Click
        Dim player = New PlayerControl()
        Dim frmAddPlayer = New FrmAddPlayer(player)
        Dim result = frmAddPlayer.ShowDialog()
        If result = DialogResult.OK Then
            Me.Controls.Add(player)
            AddHandler player.EditClicked, AddressOf CircularTextControl_EditClicked

            AddHandler player.AdvEditClicked, AddressOf AdvCircularTextControl_EditClicked
        End If

    End Sub

    Private Sub CircularTextControl_EditClicked(sender As Object, e As EventArgs)
        Dim player = DirectCast(sender, PlayerControl)
        Dim frmEdit = New FrmEditPlayer(player)
        Dim dlg = frmEdit.ShowDialog()
        If dlg = DialogResult.OK Then
            player = player
        End If
    End Sub

    Sub ClearAllPlayer()
        For i As Integer = Me.Controls.Count - 1 To 0 Step -1
            Dim control As Control = Me.Controls(i)
            If TypeOf control Is PlayerControl Then
                Me.Controls.Remove(control)
                control.Dispose()
            End If
        Next
    End Sub

    Private Sub menu_new_Click(sender As Object, e As EventArgs) Handles menu_new.Click

        ClearAllPlayer()

        CreateNewPlayer("GK", "Allision", 56, 204, Color.Green)
        CreateNewPlayer("LB", "Moreno", 153, 27)
        CreateNewPlayer("CB", "Van DijK", 153, 127)
        CreateNewPlayer("CB", "Lovren", 153, 239)
        CreateNewPlayer("RB", "Clyne", 153, 348)

        CreateNewPlayer("CM", "Wijnadium", 317, 96)
        CreateNewPlayer("CM", "Fabinho", 317, 270)

        CreateNewPlayer("AM", "Fimino", 461, 189)

        CreateNewPlayer("LW", "Origi", 536, 35)
        CreateNewPlayer("RW", "Mane", 536, 330)

        CreateNewPlayer("CF", "F.Torres", 621, 180)


    End Sub

    Private Sub CreateNewPlayer(position As String, player_name As String, x As Integer, y As Integer, Optional ByVal bgColor As Color = Nothing)
        Dim player As New PlayerControl()
        If bgColor = Nothing Then
            player.BackgroundColor = ColorTranslator.FromHtml("#D00C0F")
        Else
            player.BackgroundColor = bgColor

        End If

        player.TextValue = position
        player.NamePlayerValue = player_name
        player.Location = New Point(x, y)
        AddHandler player.EditClicked, AddressOf CircularTextControl_EditClicked
        AddHandler player.AdvEditClicked, AddressOf AdvCircularTextControl_EditClicked
        Me.Controls.Add(player)
    End Sub

    Private Sub AdvCircularTextControl_EditClicked(sender As Object, e As EventArgs)
        Dim player = DirectCast(sender, PlayerControl)
        'Dim backupPlayer = player.Clone()


        Dim clonedObject As New PlayerControl()

        clonedObject.BackgroundColor = player.BackgroundColor
        clonedObject.TextValue = player.TextValue
        clonedObject.NamePlayerValue = player.NamePlayerValue
        clonedObject.NamePlayerColor = player.NamePlayerColor
        clonedObject.NamePlayerFont = player.NamePlayerFont
        clonedObject.TextFont = player.TextFont
        clonedObject.Location = player.Location
        clonedObject.AvatarPlayerImage = player.AvatarPlayerImage
        AddHandler clonedObject.EditClicked, AddressOf CircularTextControl_EditClicked
        AddHandler clonedObject.AdvEditClicked, AddressOf AdvCircularTextControl_EditClicked
        Dim originLocation = player.Location
        Dim frmEdit = New FrmAddPlayer(player)

        Dim dlg = frmEdit.ShowDialog()
        If dlg = DialogResult.OK Then
            player.Location = originLocation
            Me.Controls.Add(player)
        Else
            Me.Controls.Add(clonedObject)
        End If

    End Sub

    Private Sub menu_clear_Click(sender As Object, e As EventArgs) Handles menu_clear.Click
        ClearAllPlayer()
    End Sub
End Class

Tạo 1 form cho menu Edit FrmEditPlayer.vb

Public Class FrmEditPlayer
    Public _playControl As PlayerControl
    Public Sub New(ByVal playControl As PlayerControl)
        InitializeComponent()
        txtPos.Text = playControl.TextValue
        txtName.Text = playControl.NamePlayerValue
        txtUrl.Text = playControl.AvatarPlayerImage
        _playControl = playControl

        If Not String.IsNullOrEmpty(txtUrl.Text) Then
            Dim pic = GetImageFromLocalDisk(txtUrl.Text)
            picImage.Image = pic
        End If

    End Sub

    Private Sub btnOk_Click(sender As Object, e As EventArgs) Handles btnOk.Click
        _playControl.TextValue = txtPos.Text.Trim
        _playControl.NamePlayerValue = txtName.Text.Trim
        _playControl.AvatarPlayerImage = txtUrl.Text.Trim
    End Sub

    Public Function GetImageFromLocalDisk(filePath As String) As Image
        Dim image As Image = Image.FromFile(filePath)
        Return image
    End Function

    Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
        Dim openFileDialog As New OpenFileDialog()
        openFileDialog.Filter = "Image Files (*.png;*.gif;*.jpg;*.jpeg)|*.png;*.gif;*.jpg;*.jpeg"

        If openFileDialog.ShowDialog() = DialogResult.OK Then
            Dim imagePath As String = openFileDialog.FileName

            picImage.Image = Image.FromFile(imagePath)
            txtUrl.Text = openFileDialog.FileName
        End If
    End Sub
End Class

Và tiếp đến tạo một form Advance Edit hay AddPlayer:

Public Class FrmAddPlayer
    Public Sub New(ByVal playerControl As PlayerControl)
        InitializeComponent()
        playerControl.Location = New System.Drawing.Point(136, 248)
        Me.Controls.Add(playerControl)
        PropertyGrid1.SelectedObject = playerControl
    End Sub

    Private Sub btnHoanTat_Click(sender As Object, e As EventArgs) Handles btnHoanTat.Click

    End Sub
End Class

Thanks for watching!

DOWNLOAD SOURCE

Founder 1310 bài viết 15,356,985

NGUYỄN THẢO

Founder at LaptrinhVB.net

★★★★★

♥ Tình yêu thương chẳng hề hư mất bao giờ. (Cr 13,4)

=========================================================================

My skills includes .NET(C#, VB.NET), DevExpress, Java, Android, PHP,

Python, Sqlserver, Mysql, Reactjs, Dart, Flutter, API services and lot more...

Phone/Zalo/Telegram/WhatsApp: ☎️ (+84)933.913122

Zalo: https://zalo.me/0933913122

Email: nguyenthao.laptrinhvb@gmail.com

My Github: https://github.com/nguyenthao1988

Facebook: https://fb.com/Lewandowski28031988

Youtube Channel: https://www.youtube.com/@thaomeotv

 

Buy me a cup of beer

 

 

       

=========================================================================