Changing the pixel color in a VB.net form? - vb.net

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

Related

VB.NET 2019 - How to Create and Save a bitmap or jpeg file image of the current form?

I have an application that uses a single form that allow users to manipulate settings used to calculate various parameters. All that works until I came to want to;
Want to save an image of that calculation (i.e. an image of the form) or
Print it.
I have found various solutions but most use C# code not VB.NET, those that have used VB.Net seem to create classes that are confusing me.
Basically I can add a button to the form, that I'd like to hide once pressed by using (btnXYZ.Visible=false), then proceed to generate an image file that I can save.
Please can somebody help?
Thank you.
Try this:
Private Function GetSnapShot() As Bitmap
Using image As Image = New Bitmap(Me.Width - 10, Me.Height - 10)
Using graphics As Graphics = graphics.FromImage(image)
graphics.CopyFromScreen(New Point(Me.Left + 5, Me.Top + 5), Point.Empty, New Size(Me.Width - 10, Me.Height - 10))
End Using
Return New Bitmap(SetBorder(image, Color.Black, 1))
End Using
End Function
Private Function SetBorder(ByVal srcImg As Image, ByVal color As Color, ByVal width As Integer) As Image
Dim dstImg As Image = srcImg.Clone()
Dim g As Graphics = Graphics.FromImage(dstImg)
Dim pBorder As Pen = New Pen(color, width)
pBorder.Alignment = Drawing2D.PenAlignment.Center
g.DrawRectangle(pBorder, 0, 0, dstImg.Width - 1, dstImg.Height - 1)
pBorder.Dispose()
g.Save()
g.Dispose()
Return dstImg
End Function
And this is how to use the code:
GetSnapShot().Save("File Path goes here where you want to save the image")

Loading up to 32768 Pictureboxes in Visual Basic

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).

Visual basic create graphics form picturebox then draw shapes

On form load event I create graphics from an empty (no image) picturebox called PB_Pixel_Layout.
Private Sub Main_From_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Pixel_Graphics = PB_Pixel_Layout.CreateGraphics
End Sub
I then draw a bunch of filled ellipses through the SetPixel(). The ellipses get drawn on the picturebox but takes 2 cycles of the the SetPixel() to show. There is also a double window image when the program starts the causes a lag and not sure what is causing the problem but I assume I have not setup the graphics correctly. I tried to run by creating a bitmap at run time instead of using a picturebox and it worked fine so the issue is narrowed down to the create graphics from picturebox. I also tried to loading an image to the picturebox properties but did not make a difference.
Private Sub SetPixel_Grid_Bitmap()
Pen_Grid = New Pen(Color.Gray)
Selected_Pen = New Pen(Color.Yellow)
'draw
For Col = 0 To intColumnCount
For Row = 0 To intRowCount
B_Color = Color.FromArgb(intPatternColorsRed(strhexPixelHexValue(intCounter + intBank)), intPatternColorsGreen(strhexPixelHexValue(intCounter + intBank)), intPatternColorsBlue(strhexPixelHexValue(intCounter + intBank)))
Brush_B = New SolidBrush(B_Color)
'// Grid
Pixel_Graphics.DrawEllipse(Pen_Grid, StartLocation.X + (Col * (intScale + 6)), StartLocation.Y + (Row * (intScale + 6)), intScale, intScale)
'// Fill with color
Pixel_Graphics.FillEllipse(Brush_B, StartLocation.X + (Col * (intScale + 6)) + 2, StartLocation.Y + (Row * (intScale + 6)) + 2, intScale - 4, intScale - 4)
'// Selected
If ArrPixelData_Array(intCounter)(P_Selected) = 1 Then
Pixel_Graphics.DrawEllipse(Selected_Pen, StartLocation.X + (Col * (intScale + 6)), StartLocation.Y + (Row * (intScale + 6)), intScale, intScale)
End If
intCounter = intCounter + 1
Next Row
Next Col
End Sub
Here is the update
Public Sub RefreshDrawing()
bm = New Bitmap(PB_Pixel_Layout.Width, PB_Pixel_Layout.Height)
Using g As Graphics = Graphics.FromImage(BB)
g.SmoothingMode = SmoothingMode.AntiAlias
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
End Using
PB_Pixel_Layout.Image = bm ' assign drawn bitmap to picturebox
End Sub
I would suggest to declare a global bitmap
Dim bm As Bitmap
And create a refresh function like (just a general suggestion):
Public Sub RefreshDrawing()
bm = New Bitmap(Me.Drawing.Width, Me.Drawing.Height)
Using g = Graphics.FromImage(bm)
g.SmoothingMode = SmoothingMode.AntiAlias
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
Dim r as New RectangleF (200, 100, 400, 300)
g.FillEllipse(pDrwStyle.dstBrush, r) ' draw inside points (area)
g.DrawEllipse(pDrwStyle.dstPen, Rectangle.Round(r)) ' draw ellipse border
End Using
Me.PictureBox1.Image = bm ' assign drawn bitmap to picturebox
End Sub
And in you load event (and perhaps a Refresh button) put simply:
Call RefreshDrawing()
This is very fast and reliable way of drawing graphics.
I would suggest not to use Paint event. Only for temporary drawing, such as drawing in MouseMove mode and such.
As an Alternate suggestion, you could draw it all to a buffer then render that when required.
Like this:
Dim myContext As New BufferedGraphicsContext
Dim mybuff As System.Drawing.BufferedGraphics
(As Globals)
Then add this* before you start drawing anything.
mybuff = myContext.Allocate(picturebox1.CreateGraphics, rectangle)
mybuff.Graphics.CompositingMode = Drawing2D.CompositingMode.SourceOver
mybuff.Graphics.CompositingQuality = Drawing2D.CompositingQuality.AssumeLinear
mybuff.Graphics.SmoothingMode = Drawing2D.SmoothingMode.None
mybuff.Graphics.InterpolationMode = CType(Drawing2D.QualityMode.Low, Drawing2D.InterpolationMode)
mybuff.Graphics.PixelOffsetMode = Drawing2D.PixelOffsetMode.None
*Only first line is required the rest is an example custom configuration.
rectangle is the size of your buffer, it needs to be at least as large as the images destination (picturebox1)
To draw into the buffer just type mybuff.Graphics...
eg.
mybuff.Graphics.FillRectangle(colbrush,50,50, 4, 4)
mybuff.Graphics.FillEllipse(colbrush, 100, 100, 50, 30)
...
When done building the image it needs to be rendered/painted onto the target (picturebox1) like so:
mybuff.Render
The render does not need to come directly after the drawing it can be called from anywhere in your code. So its up to you when it is painted and how often.
Also doing it like this is much faster than drawing directly to a target.
Lastly dispose of my buff and mycontext when you are done with them.
[EDIT]
Forgot to mention that you can also render the buffer to other targets like so:
Mybuff.Render(picturebox2.CreateGraphics)
Mybuff.Render(picturebox47.CreateGraphics)

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.

Drawing rect in picturebox not done to right scale for mouse

I currently have a picture box where the user will click and drag to draw a rectangle over an image (one that can be changed regularly). When they're done (mouse_up), I will display the relative points of the rect in a text box to the resolution.
So, for example, the user draws from top left (0,0) to bottom right of a 1920 x 680 image (picturebox.right, picturebox.bottom) for a rect, the text box will show (1920,680) for the end point. That's mostly just ratio stuff.
I am using the code from an answer of a previous question of mine (Having trouble drawing simple rectangle in picturebox) to draw it.
The Problem: The box doesn't follow the mouse since the images have to be done in stretch mode. They're usually pretty large (like 1920 x 680) and can't fit in a regular gui. There are multiple resolutions, so got to go dynamic with the ratios. Without editing, this code works great in normal mode, but that doesn't work for usability. So, when you draw the box, it's really small and not relative to the mouse (so I can't display the end point on the textboxes).
Here's an example of what I mean. I've dragged my mouse halfway across the image:
What I've tried: I've attempted to counter act it by ratios, but it still doesn't fix the displaying the end point issue, or does it really follow the mouse that well. It's usually off by at least 10 or so pixels to the left. Here's my adjusted code for that:
Private Sub DrawRectangle(ByVal pnt As Point)
Try
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles
Dim w_ratio As Integer = Math.Floor(img.Width / pbZoneImage.Width)
Dim h_ratio As Integer = Math.Floor(img.Height / pbZoneImage.Height)
Dim customPen As New Pen(currentColor, 5)
'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
' g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)
'Else
theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X * w_ratio), Math.Min(mouse_Down.Y, pnt.Y * h_ratio),
Math.Abs(mouse_Down.X - pnt.X * w_ratio), Math.Abs(mouse_Down.Y - pnt.Y * h_ratio))
g.DrawRectangle(customPen, theRectangle)
'End If
g.Dispose()
pbZoneImage.Invalidate() 'draw img to picturebox
Catch ex As Exception
End Try
End Sub
I've also tried just getting the end display point (x,y) to match the relative end of the rectangle, but again it isn't working with the ratios.
Any ideas on how to make this work as well as it does in normal mode as it does in stretch? I'm also open to different controls or just any tips in general. Thanks!
This can be done with many ways but the easiest is to use a picturebox with SizeMode = Normal. Load your images:
img = New Bitmap(pbZoneImage.Width, pbZoneImage.Height)
imgClone = My.Resources.... 'real dimensions
Dim g As Graphics = Graphics.FromImage(img)
'it will scale the image, no need for stretch mode
g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height)
g.Dispose()
pbZoneImage.Image = img
Then draw normally:
Private Sub DrawRectangle(ByVal pnt As Point)
Try
Dim g As Graphics
g = Graphics.FromImage(img)
g.DrawImage(imgClone, 0, 0, pbZoneImage.Width, pbZoneImage.Height) 'we are clearing img with imgClone. imgClone contains the original image without the rectangles
Dim customPen As New Pen(currentColor, 5)
'If pnt.X = mouse_Down.X Or pnt.Y = mouse_Down.Y Then
' g.DrawLine(customPen, mouse_Down.X, mouse_Down.Y, pnt.X * w_ratio, pnt.Y * h_ratio)
'Else
theRectangle = New Rectangle(Math.Min(mouse_Down.X, pnt.X), Math.Min(mouse_Down.Y, pnt.Y),
Math.Abs(mouse_Down.X - pnt.X), Math.Abs(mouse_Down.Y - pnt.Y))
g.DrawRectangle(customPen, theRectangle)
'End If
g.Dispose()
pbZoneImage.Invalidate() 'draw img to picturebox
Catch ex As Exception
End Try
End Sub
In mouse up event scale to get the correct result:
Private Sub pbZoneImage_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles pbZoneImage.MouseUp
Dim width, height As Integer
width = CInt(Math.Abs(mouse_Down.X - e.X) * (imgClone.Width / pbZoneImage.Width))
height = CInt(Math.Abs(mouse_Down.Y - e.Y) * (imgClone.Height / pbZoneImage.Height))
TextBox1.Text = width.ToString + " " + height.ToString
End Sub