Question

我正在设计一个六边形网格，我需要能够为每个六边形命名，所以我稍后可以参考它们。下面是我的类，它生成六边形网格，我已经标记了代码，所以你可以理解发生了什么。我一直在寻找一段时间阅读很多关于图形的内容，但我无法通过我见过的答案得到一个有效的设计。也许，我通过使用Graphics会出现这种错误，但我的计划是能够点击每个六边形并使用它做一些事情。

注意：如果您看到改进我的代码的方法，请告诉我。非常感谢！

' Generate Hexagon Grid
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint

    ' Hexagon Grid Parameters
    Dim HexagonRadius As Integer = 20 ' Fix "Position Hexagon Grid Columns" Before Changing Hexagon Radius
    Dim GridSize As Integer = 10

    ' Generate Hexagon Grid
    Dim HexagonX As Integer = HexagonRadius
    Dim HexagonY As Integer = HexagonRadius
    For i As Integer = 1 To GridSize
        For j As Integer = 1 To GridSize

            ' Hexagon Vertex Coordinates
            Dim point1 As New Point((HexagonX - HexagonRadius), (HexagonY))
            Dim point2 As New Point((HexagonX - (HexagonRadius / 2)), (HexagonY + ((HexagonRadius / 2) * Math.Sqrt(3))))
            Dim point3 As New Point((HexagonX + (HexagonRadius / 2)), (HexagonY + ((HexagonRadius / 2) * Math.Sqrt(3))))
            Dim point4 As New Point((HexagonX + HexagonRadius), (HexagonY))
            Dim point5 As New Point((HexagonX + (HexagonRadius / 2)), (HexagonY - ((HexagonRadius / 2) * Math.Sqrt(3))))
            Dim point6 As New Point((HexagonX - (HexagonRadius / 2)), (HexagonY - ((HexagonRadius / 2) * Math.Sqrt(3))))
            Dim hexagonPoints As Point() = {point1, point2, point3, point4, point5, point6}

            ' Create Hexagon
            e.Graphics.FillPolygon(Brushes.Green, hexagonPoints)

            ' Hexagon Outline
            e.Graphics.DrawLine(Pens.Black, point1, point2)
            e.Graphics.DrawLine(Pens.Black, point2, point3)
            e.Graphics.DrawLine(Pens.Black, point3, point4)
            e.Graphics.DrawLine(Pens.Black, point4, point5)
            e.Graphics.DrawLine(Pens.Black, point5, point6)
            e.Graphics.DrawLine(Pens.Black, point6, point1)

            ' Position Hexagon Grid Columns
            HexagonY += 34 ' Specific to Hexagon Radius: 20
        Next
        If i Mod 2 > 0 Then
            HexagonY = 36.75 ' Specific to Hexagon Radius: 20
        Else
            HexagonY = 20 ' Specific to Hexagon Radius: 20
        End If
        HexagonX += 30 ' Specific to Hexagon Radius: 20
    Next
End Sub

Answer 1

您需要使用它的坐标创建一些Hexagon类（如果确实需要，可能是名称）。并将它们保存到一些合适的集合（可能是二维数组？）这应该发生在Paint事件之外的某个地方，并且可能会在网格SizeChanged事件中重新计算。

在您的Paint事件中，您只需迭代现有的集合并根据预先计算的坐标进行渲染。

OnClick事件将遍历同一个集合，以查找特定的Hexagon进行更新（例如更改背景颜色）并强制表单重新生效。

对于大型渲染，您应该首先考虑渲染到位图并将最终位图绘制到e.Graphics以加快工作速度。您的位图也可以缓存，以加快速度。

编辑：已添加代码示例

在项目属性中启用Option Strict On，以避免代码中出现许多您不知道的问题。

Public Class frmTest

    Private Const HexagonRadius As Integer = 20
    Private Const GridSize As Integer = 10

    Private fHexagons As New List(Of Hexagon)
    Private fCache As Bitmap
    Private fGraphics As Graphics

    Private Sub ResetHexagons() 'Call when some parameter changes (Radius/GridSize)
        fHexagons.Clear()
        Invalidate()
    End Sub

    Private Function EnsureHexagons() As List(Of Hexagon)
        Dim X, Y As Single, xi, yi As Integer
        If fHexagons.Count = 0 Then
            X = HexagonRadius : Y = HexagonRadius
            For xi = 1 To GridSize
                For yi = 1 To GridSize
                    fHexagons.Add(New Hexagon(HexagonRadius, X, Y))
                    Y += 34
                Next
                'Do your math to get theese values from HexagonRadius value
                If xi Mod 2 > 0 Then
                    Y = 36.75
                Else
                    Y = 20
                End If
                X += 30
            Next
            fCache?.Dispose()
            fGraphics?.Dispose()
            fCache = New Bitmap(GridSize * HexagonRadius * 2, GridSize * HexagonRadius * 2)
            fGraphics = Graphics.FromImage(fCache)
            For Each H As Hexagon In fHexagons
                H.Render(fGraphics)
            Next
        End If
        Return fHexagons
    End Function

    Private Sub frmTest_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        EnsureHexagons()
        e.Graphics.DrawImageUnscaled(fCache, Point.Empty)
    End Sub

    Private Sub frmTest_MouseClick(sender As Object, e As MouseEventArgs) Handles Me.MouseClick
        Dim H As Hexagon = EnsureHexagons.FirstOrDefault(Function(X) X.Contains(e.Location))
        If H IsNot Nothing Then
            H.Checked = Not H.Checked
            H.Render(fGraphics) 'Update cache without repainting all
            Invalidate()
        End If
    End Sub

End Class

Public Class Hexagon

    Public ReadOnly Radius, X, Y As Single
    Public ReadOnly Points() As PointF
    Public Property Checked As Boolean

    Public Sub New(Radius As Single, X As Single, Y As Single)
        Me.Radius = Radius : Me.X = X : Me.Y = Y
        Points = {New PointF((X - Radius), (Y)),
                    New PointF((X - (Radius / 2)), CSng(Y + ((Radius / 2) * Math.Sqrt(3)))),
                    New PointF((X + (Radius / 2)), CSng(Y + ((Radius / 2) * Math.Sqrt(3)))),
                    New PointF((X + Radius), (Y)),
                    New PointF((X + (Radius / 2)), CSng(Y - ((Radius / 2) * Math.Sqrt(3)))),
                    New PointF((X - (Radius / 2)), CSng(Y - ((Radius / 2) * Math.Sqrt(3.0!))))}
    End Sub

    Public Sub Render(G As Graphics)
        ' Create Hexagon
        G.FillPolygon(If(Checked, Brushes.Blue, Brushes.Green), Points)
        ' Hexagon Outline
        For i As Integer = 0 To Points.Length - 1
            G.DrawLine(Pens.Black, Points(i), Points((i + 1) Mod Points.Length))
        Next
    End Sub

    Public Function Contains(P As Point) As Boolean
        'Do your math here, this is just simplified estimation
        Return X - Radius <= P.X AndAlso P.X <= X + Radius AndAlso Y - Radius <= P.Y AndAlso P.Y <= Y + Radius
    End Function

End Class

为动态创建的形状赋予名称

1 个答案: