时间戳

首页 > 解决方案 > 在 Visual Basic 中加载多达 32768 个图片框

vb.net - 在 Visual Basic 中加载多达 32768 个图片框

问题描述

我有一个应用程序正在加载 32^2 到 32768 个 8x8 像素图片框。所有图片框都在屏幕上，所以我需要全部加载，不能只加载一些。

就目前而言，我的程序甚至不会运行。有没有更好的方法来加载这么多图片框？

我想和你分享我的项目，但我不知道如何......

不过谢谢！

标签： vb.netpicturebox

解决方案

使用这种设计，您可能会遇到 MemoryOverflowException。从它的声音来看，如果是这种情况，您可能正在尝试渲染某种地图，那么这个答案适合您（否则就忽略它）。

在较高的级别上，您应该只创建在任何给定时间可以在屏幕上显示的 PictureBox 控件的数量。您可以使用以下函数进行计算：

Private Function CalculateSizeToFitParent(ByVal parent As Control, ByVal childSize As Size) As Size
    Return New Size(parent.Width \ childSize.Width, parent.Height \ childSize.Height)
End Sub

您可以这样实现它以创建一个 PictureBox 来填充当前表单的可见区域：

Dim pictureBoxSize As Size = New Size(8, 8)
Dim visibleArea(pictureBoxSize.Width - 1, pictureBoxSize.Height - 1) As PictureBox
Dim numberOfPictureBoxes As Size = CalculateSizeToFitParent(Me, pictureBoxSize)

For x As Integer = 0 To numberOfPictureBoxes.Width - 1
    For y As Integer = 0 To numberOfPictureBoxes.Height - 1
        visibleArea(x, y) = New PictureBox() With {
            .Location = New Point(x * pictureBoxSize.Width, y * pictureBoxSize.Height)
            .Size = pictureBoxSize
        }
        Me.Controls.Add(visibleArea(x, y))
    Next
Next

下一部分分为两部分：

  1. 您需要跟踪当前可见的左上角在哪里
  2. 您将需要在地图的相应可视区域中重新加载图像。

这假设您有一个存储图像的二维数组。请注意，您不会重新创建 PictureBox 控件，而只是重新加载现有控件的图像：

Private _currentLocation As Point = New Point(0, 0) ' If you're starting somewhere else change it here
Public Property CurrentLocation As Point
    Get
        Return _currentLocation
    End Get
    Set(ByVal value As Point)
        If (value <> _currentLocation) Then
            _currentLocation = value
            Me.OnCurrentLocationChanged()
        End If
    End Set
End Property

Protected Overridable Sub OnCurrentLocationChanged()
    RaiseEvent CurrentLocationChanged(Me, EventArgs.Empty)
End Sub

Public Event CurrentLocationChanged(ByVal sender As Object, ByVal e As EventArgs)

Private Sub MyForm_CurrentLocationChanged(ByVal sender As Object, ByVal e As EventArgs) Handles Me.CurrentLocationChanged
    If (visibleArea Is Nothing) Then
        Throw New Exception("The visible area has not been generated yet.")
    End If
    If (_currentLocation Is Nothing) Then
        Throw New Exception("The CurrentLocation cannot be null.")
    End If

    Dim widthUpperBounds As Integer = My2DArrayOfImageLocations.GetUpperBounds(0) - 1
    Dim heightUpperBounds As Integer = My2DArrayOfImageLocations.GetUpperBounds(1) - 1
    For x As Integer = 0 To visibleArea.GetUpperBounds(0) - 1
        For y As Integer = 0 To visibleArea.GetUpperBounds(1) - 1
            If (x + _currentLocation.Width > widthUpperBounds OrElse y + _currentLocation.Height) Then
                'This "block" is outside the view area (display a blank tile?)
            Else
                visibleArea(x, y).Load(My2DArrayOfImageLocations(x + _currentLocation.Width, y + _currentLocation.Height))
            End If
        Next
    Next
End Sub

现在，无论何时您重置 CurrentLocation 属性（但是您会这样做，例如箭头键、asdw 等），它将重新绘制地图的可见区域。

更新 请注意，我“自由输入”了这个例子，你可能需要稍微调整一下。经过一番思考，您可能还需要在加载图像时调用 PictureBox 的 Refresh 方法（我没有测试）。

推荐阅读