Loading up to 32768 Pictureboxes in Visual Basic - vb.net

I have a app which is loading between 32^2 to 32768 8x8 px pictureboxes. All pictureboxes are on screen so I need to load them all and can't just load some.
As it stands, my program won't even run. Is there a better way to load that many pictureboxes?
I would like to share with you my project, but I don't know how to.............
Thanks though!

You'd likely run into a MemoryOverflowException with this design. From the sound of it, you're probably trying to render a map of some sort if that's the case then this answer is for you (otherwise just ignore it).
At a high level you should only create the number of PictureBox controls that can fit on the screen at any given time. You can calculate this with the following function:
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
You would implement it as such to create a PictureBox to fill up the visible area of the current Form:
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
The next part is two-fold:
You need to keep track of where the top-left corner of the current visible are is
You will need to reload the images in the respective visual area of the map.
This assumes that you have a 2D array that stores your images. And please note that you don't recreate the PictureBox controls but rather you just reload the image of the existing control:
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
Now whenever you reset the CurrentLocation property (however you'd do that, e.g. arrow keys, asdw, etc.) it will redraw the visible area of the map.
Update
Please note that I "free-typed" this example and you may need to tweak it a bit. After some more thought, you'll probably also need to call the Refresh method of the PictureBox when you load in the image (I didn't test).

Related

Problems with generating labels

The Problem: I'm programmatically generating labels but am having trouble referencing them in code because they don't exist at runtime.
The Context: For a game, I've generated a 10x10 grid of labels with the following:
Public lbl As Label()
Dim tilefont As New Font("Sans Serif", 8, FontStyle.Regular)
Private Sub Lucror_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim i As Integer = 0
Dim a As Integer = 0
Dim height As Integer
Dim width As Integer
height = 30
width = 30
ReDim lbl(99)
For i = 0 To 99
lbl(i) = New Label
lbl(i).Name = i
lbl(i).Size = New System.Drawing.Size(30, 30)
lbl(i).Location = New System.Drawing.Point((width), height)
lbl(i).Text = i
lbl(i).Font = tilefont
Me.Controls.Add(lbl(i))
width = width + 30
a = a + 1 'starting new line if required
If (a = 10) Then
height = height + 30
width = 30
a = 0
End If
Next
End Subenter code here
This worked fine but the labels function as tiles in the game and game tiles need to store 2-3 integers each as well as be able to be referenced through event handlers. I figured a possible way to store integers would be to generate 100 arrays, each named after a label and each holding the 2-3 integers, but that seems very redundant.
What I need:
On click and on hover event handlers for every label
An array (or dictionary?) to store 2-3 integers for every label
Labels have to reference each others names ie. do something to label with name (your name + 1).
The Question: Is there a simple way to achieve these three things with the current way I generate labels (and if so, how?) and if not, how else can I generate the 100 labels to make achieving these things possible?
Any help is much appreciated.
Your labels do exist at runtime, but not at compile time. Attaching events is a little different at runtime, you must use AddHandler.
Below is some sample code that should illustrate everything you're asking for. I've introduced inheritance as a way of saving data that is pertinent to each tile. The GameTile type behaves exactly as a label, and we've added some functionality for storing integers and naming the control.
Public Class Form1
Dim tilefont As New Font("Sans Serif", 8, FontStyle.Regular)
Public Property GameTiles As List(Of GameTile)
Private Sub Lucror_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim a As Integer = 0
Dim xPosition As Integer = 30
Dim yPosition As Integer = 30
GameTiles = New List(Of GameTile)
For i = 0 To 99
Dim gt As New GameTile(i.ToString)
gt.Size = New System.Drawing.Size(30, 30)
gt.Location = New System.Drawing.Point((yPosition), xPosition)
gt.Font = tilefont
gt.Integer1 = i + 1000
gt.Integer2 = i + 2000
gt.Integer3 = i + 3000
Me.Controls.Add(gt)
AddHandler gt.Click, AddressOf TileClickHandler
GameTiles.Add(gt)
yPosition = yPosition + 30
a = a + 1 'starting new line if required
If (a = 10) Then
xPosition = xPosition + 30
yPosition = 30
a = 0
End If
Next
End Sub
Private Sub TileClickHandler(sender As Object, e As EventArgs)
Dim gt = CType(sender, GameTile)
MsgBox("This tile was clicked: " & gt.Text &
Environment.NewLine & gt.Integer1 &
Environment.NewLine & gt.Integer2 &
Environment.NewLine & gt.Integer3)
End Sub
End Class
Public Class GameTile
Inherits Label
'this class should be in a separate file, but it's all together for the sake of clarity
Public Property Integer1 As Integer
Public Property Integer2 As Integer
Public Property Integer3 As Integer
Public Sub New(NameText As String)
MyBase.New()
Name = NameText
Text = NameText
End Sub
End Class

Fitting runtime buttons inside a form

I have a number of buttons between 5-20 and it's variable each time the form loads based on the user settings. I am trying to fit all these buttons on my form no matter what the size of the form is. The buttons are generated during runtime. I would like the first button to be 20 points from the top bar (at any size) and the rest of the buttons simply to fit in the form. This is what I have now but I have to maximize the form to view them all and also while I'm expanding the form the space between the buttons decreases and they overlap with each other whereas they should keep a relative distance. Any ideas?
Dim iButtonWidth, iButtonHeight, iVerticalSpace As Integer
If UserButtons.Count > 0 Then
iButtonHeight = Me.Size.Height - (Me.Size.Height * 0.85)
iButtonWidth = Me.Size.Width - (Me.Size.Width * 0.5)
iVerticalSpace = iButtonHeight / 3
For Each btn In UserButtons
btn.Size = New System.Drawing.Size(iButtonWidth, iButtonHeight)
btn.Location = New Point(20, 20 + btn.TabIndex * iVerticalSpace * 3)
Next
End If
Here's a quick example using the TableLayoutPanel to play with:
Public Class Form1
Private UserButtons As New List(Of Button)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Static R As New Random
Dim NumButtons As Integer = R.Next(5, 21) ' "a number of buttons between 5-20 and it's variable each time"
UserButtons.Clear()
For i As Integer = 1 To NumButtons
Dim btn As New Button()
btn.Text = i.ToString("00")
btn.Dock = DockStyle.Fill ' Optional: See how you like it with this on vs. off
UserButtons.Add(btn)
Next
DisplayButtons()
End Sub
Private Sub DisplayButtons()
TableLayoutPanel1.SuspendLayout()
TableLayoutPanel1.Controls.Clear()
TableLayoutPanel1.ColumnStyles.Clear()
TableLayoutPanel1.ColumnCount = 5 ' Fixed Number of Columns
For i As Integer = 1 To TableLayoutPanel1.ColumnCount
TableLayoutPanel1.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 911)) ' the size doesn't matter here, as long as they are all the same
Next
' Variable Number of Rows:
Dim RowsRequired As Integer = ((UserButtons.Count - 1) \ TableLayoutPanel1.ColumnCount) + 1 ' Integer Division
TableLayoutPanel1.RowStyles.Clear()
TableLayoutPanel1.RowCount = RowsRequired
For i As Integer = 1 To TableLayoutPanel1.RowCount
TableLayoutPanel1.RowStyles.Add(New RowStyle(SizeType.Percent, 911)) ' the size doesn't matter here, as long as they are all the same
Next
TableLayoutPanel1.Controls.AddRange(UserButtons.ToArray)
TableLayoutPanel1.ResumeLayout()
End Sub
End Class
First of all what kind of container are the buttons in? You should be able to set the container's AutoScroll property to true - then when controls within it spill out of the visible bounds you will get a scroll bar.
Then also what you could do is draw each button in more of a table with a certain number next to each other before dropping down to the next line (instead of just 1 button on each line). If that is an option that works for you then you could get more buttons within the visible space.
I happen to have an example to do the same thing with picture boxes (and text boxes under each picture box). Hope this helps:
Dim point As New Point(0, 0)
'create 11 picture and text boxes-you can make this number the number your user selects.
Dim box(11) As PictureBox
Dim text(11) As TextBox
Dim i As UInt16
For i = 0 To 11 'or whatever your number is
box(i) = New PictureBox
box(i).Width = 250 'your button width
box(i).Height = 170 'your button height
box(i).BorderStyle = BorderStyle.FixedSingle
box(i).Location = point
layoutsPanel.Controls.Add(box(i)) 'my container is a panel
text(i) = New TextBox
text(i).Height = 50
text(i).Width = 250
point.Y += box(i).Height
text(i).Location = (point)
layoutsPanel.Controls.Add(text(i))
point.Y -= box(i).Height 'reset Y for next picture box
'Put 4 picture boxes in a row, then move down to next row
If i Mod 4 = 3 Then
point.X = 0
point.Y += box(i).Height + text(i).Height + 4
Else
point.X += box(i).Width + 4
End If
Next

vb.net how can zoom image

I have a Custom Control for viewing images with zooming facility but without scrollBar, and its working condition is good. Actually The Custom Control is a Panel with a Picutrbox on it. I also using a TrackBar for zooming in/out the image. It is also working better.
But I am not fully satisfied, even it is covering the purpose of my App because I need zooming PictureBox based on center point. Now it is anchoring Top Left.
Another One is when Zooming out the image, the image goes to zero size at TrackBar's Zero. Even I limited zoom level to the panel size and working good, my unsatisfaction taking place here also, as it is not responding at zero level of TrackBar. Here I need, the original size of image loaded in picture box have to go for 100% of TrackBar and when image reached at Custom controle size have to go for 0% of TrackBar. Then I will fullfilled.
I figuring my code here.........
My Custom Control is a User Control Inheriting from Panel.
code for cutom control :
Public Class ImageViewer
Inherits Panel
Dim AutoScaleDimensions As SizeF
Dim AutoScaleMode As AutoScaleMode
Protected Overrides Sub DefWndProc(ByRef m As Message)
If m.Msg <> 131 Then
MyBase.DefWndProc(m)
End If
End Sub
End Class
On Form1, I Placed my Custom Control- ImageViewer1 and also placed PicutreBox1 with in ImageViewer1, Palced Button1 and TrackBar1 on Form1
Changed Properties as follows
ImageViewer1 - AutoScroll=True
PicutreBox1 - SizeMode=Zoom
TrackBar1- Maximum=100
My Declared Variables are
Dim imgName As String
Private SliderCenter As Integer = 50
Private originalImg As Bitmap
Code for Button1.Click
Try
Dim inputImg As FileDialog = New OpenFileDialog()
inputImg.Filter = "Image File (*.Jpg;*.Bmp;*.Png;*.Gif;*.Tiff;*.Tif;*.PDF)|*.Jpg;*.Bmp;*.Png;*.Gif;*.Tiff;*.Tif;*.PDF"
If inputImg.ShowDialog() = DialogResult.OK Then
imgName = inputImg.FileName
originalImg = New Bitmap(inputImg.FileName)
Dim newImg As New Bitmap(imgName)
PictureBox1.Image = DirectCast(newImg, Image)
End If
inputImg = Nothing
Catch ae As System.ArgumentException
imgName = ""
MessageBox.Show(ae.Message.ToString)
Catch ex As Exception
MessageBox.Show(ex.Message.ToString)
End Try
Code for TrackBar1.ValueChanged
If originalImg IsNot Nothing Then
If TrackBar1.Value > 0 Then
Dim scale As Double = TrackBar1.Value
Dim height As Integer = Convert.ToInt32((scale / SliderCenter) * originalImg.Height)
Dim width As Integer = Convert.ToInt32((scale / SliderCenter) * originalImg.Width)
PictureBox1.Size = New Size(width, height)
If PictureBox1.Width <= ImageViewer1.Width Then
PictureBox1.Size = New Size(PictureBox1.Width + (ImageViewer1.Width - PictureBox1.Width), ImageViewer1.Height)
End If
If PictureBox1.Height <= ImageViewer1.Height Then
PictureBox1.Size = New Size(ImageViewer1.Width, PictureBox1.Height + (ImageViewer1.Height - PictureBox1.Height))
End If
End If
End If
Please help me in your kind ........ Thank You.

Determine tablelayoutpanel item dropped into

I am trying to determine which cell (row/column) of my TableLayoutPanel the user drops an object into. Currently I have only been able to find how to determine coordinates of where the item is dropped which is:
Dim location As Point = TableLayoutPanel1.PointToClient(New Point(e.X, e.Y))
However I can not figure out how to locate which cell that is in. I did find the command GetCellPosition and attempted that with the coordinates; however that did not work either.
TableLayoutPanel1.GetCellPosition(location)
You can try this function:
Private Function GetCellFromPoint(p As Point) As Point
Dim result As New Point(-1, -1)
Dim colWidths As Integer() = tlp.GetColumnWidths()
Dim rowHeights As Integer() = tlp.GetRowHeights()
Dim top As Integer = 0
For y As Integer = 0 To rowHeights.Length - 1
Dim left As Integer = 0
For x As Integer = 0 To colWidths.Length - 1
If New Rectangle(left, top, colWidths(x), rowHeights(y)).Contains(p) Then
result = New Point(x, y)
End If
left += colWidths(x)
Next
top += rowHeights(y)
Next
Return result
End Function
It just loops through the rows and columns to see if the passed in point is inside the existing cell. Note though, that GetColumnWidths and GetRowHeights do not appear in the intellisense dropdown.
Usage:
Private Sub tlp_MouseMove(sender As Object, e As MouseEventArgs) _
Handles tlp.MouseMove
Me.Text = GetCellFromPoint(e.Location).ToString
End Sub
BTW, GetCellPosition is expecting a control to be passed as a parameter, not a Point structure.
You can also use TableLayoutPanelCellPosition in place of Point in this function, since that is what GetCellPosition is returning in its function.
I have used this function (thanks a million) but I have found an issue. To define correctly the cell where the object is droped, we need to take into account the location of the TableLayoutPanel in the screen. I have solved this making the declaration of p (build with e.X and e.Y in the DragDrop event) and r (a reference of the location of the TableLayoutPanel in the screen).
Then you have to assing p = p - r and send that P to the function GetCellFromPoint(p).
Private Sub TableLayoutPanel1_DragDrop(sender As Object, e As DragEventArgs) Handles TableLayoutPanel1.DragDrop
Dim p As New Point(e.X, e.Y)
Dim r As Point
r = TableLayoutPanel1.PointToScreen(New Point(0, 0))
p.X = p.X - r.X
p.Y = p.Y - r.Y
MessageBox.Show(GetCellFromPoint(p).ToString)
End Sub

Changing the pixel color in a VB.net form?

How would I change the colour of individual pixels in a VB.NET form?
Thanks.
A hard requirement for Winforms is that you should be able to redraw the form whenever Windows asks it to. Which will happen when you minimize and restore the window. Or on older versions of Windows when you move another window across yours.
So just setting pixels on the window isn't good enough, you are going to lose them all when the window redraws. Instead use a bitmap. An additional burden is that you are going to have to keep the user interface responsive so you need to do your calculations on a worker thread. The BackgroundWorker is handy to get that right.
One way to do this is to use two bitmaps, one you fill in the worker and another that you display. Every, say, one row of pixels make a copy of the in-work bitmap and pass that to ReportProgress(). Your ProgressChanged event then disposes the old bitmap and stores the new passed one and calls Invalidate to force a repaint.
You might benefit from these resources: Setting background color of a form
DeveloperFusion forum , and extracting pixel color
Here's some demo code. It's slow to repaint, for the reasons Hans mentioned. A simple way to speed it up would be to only recalculate the bitmap after a delay.
Public Class Form1
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
'create new bitmap
If Me.ClientRectangle.Width <= 0 Then Exit Sub
If Me.ClientRectangle.Height <= 0 Then Exit Sub
Using bmpNew As New Bitmap(Me.ClientRectangle.Width, Me.ClientRectangle.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
'draw some coloured pixels
Using g As Graphics = Graphics.FromImage(bmpNew)
For x As Integer = 0 To bmpNew.Width - 1
For y As Integer = 0 To bmpNew.Height - 1
Dim intR As Integer = CInt(255 * (x / (bmpNew.Width - 1)))
Dim intG As Integer = CInt(255 * (y / (bmpNew.Height - 1)))
Dim intB As Integer = CInt(255 * ((x + y) / (bmpNew.Width + bmpNew.Height - 2)))
Using penNew As New Pen(Color.FromArgb(255, intR, intG, intB))
'NOTE: when the form resizes, only the new section is painted, according to e.ClipRectangle.
g.DrawRectangle(penNew, New Rectangle(New Point(x, y), New Size(1, 1)))
End Using
Next y
Next x
End Using
e.Graphics.DrawImage(bmpNew, New Point(0, 0))
End Using
End Sub
Private Sub Form1_ResizeEnd(sender As Object, e As System.EventArgs) Handles Me.ResizeEnd
Me.Invalidate() 'NOTE: when form resizes, only the new section is painted, according to e.ClipRectangle in Form1_Paint(). We invalidate the whole form here to form an entire form repaint, since we are calculating the colour of the pixel from the size of the form. Try commenting out this line to see the difference.
End Sub
End Class