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.
Related
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).
I have a software that builds a 3D text by using grafx.DrawString() and I need to copy this graphic to clipboard. When I try to do so, it throws a NullReferenceException.
How can I copy the graphics drawn on a PictureBox?
This is the code to draw the text:
Dim grafx As Graphics
Private Sub draw_block_text10()
Dim text_size As SizeF
Dim back_brush As Brush = Brushes.Black 'COLOR FOR THE BOARDER TEXT
Dim fore_brush As Brush = Brushes.Blue 'COLOR FOR THE MAIN TEXT
Dim fnt As New Font("Microsoft Sans Serif", NumericUpDown1.Value, FontStyle.Regular)
Dim location_x, location_y As Single 'USED IT FOR THE LOCATION
Dim i As Integer
'CREATE A GRAPHIC OBJECT IN THE PICTUREBOX.
grafx = Me.PictureBox2.CreateGraphics()
'CLEAR THE PICTUREBOX
grafx.Clear(Color.White)
'LOOK THE REQUIRED SIZE TO DRAW THE TEXT
text_size = grafx.MeasureString(Me.TextBox1.Text, fnt)
'ELIMINATE THE REDUNDANT CAlCULATION AFTER GETTING THE LOCATION.
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
'FIRST, DRAW THE BLACK BACKGROUND TO GET THE EFFECT,
'AND THE TEXT MUST BE DRAWN REAPETEDLY FROM THE OFFSET RIGHT, UP TO THE MAIN TEXT IS DRAWN.
For i = CInt(nupDepth.Value) To 0 Step -1
grafx.DrawString(TextBox1.Text, fnt, back_brush, _
location_x - i, location_y + i)
Next
Dim mydataandtimeforsave = DateTime.Now.ToString("yyyyMMddHHmmss")
'DRAW THE ROYAL BLUE FOR THE MAIN TEXT OVER THE BLACk TEXT
grafx.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
Dim bmp As New Bitmap(Me.PictureBox2.Width, Me.PictureBox2.Height)
Dim g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.Transparent)
''Perform Drawing here
End Sub
This is the code to copy to clipboard:
Clipboard.SetDataObject( _
DirectCast(PictureBox2.Image.Clone, Bitmap), _
True)
Beep()
Using a Graphics object created from a PictureBox control (PictureBox.CreateGraphics()) to draw on doesn't actually set/change the Image property of the PictureBox. You can confirm that by checking for PictureBox2.Image Is Nothing, which will return true if the PictureBox had no image before drawing on it.
Instead, create an Image with the dimensions of the PictureBox, use Graphics.FromImage() to create your Graphics object, draw what you need to draw, and then assign the image to the PictureBox.Image property.
Something like this should work fine:
Dim bmp As New Bitmap(PictureBox2.Width, PictureBox2.Height)
Using g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.White)
text_size = g.MeasureString(Me.TextBox1.Text, fnt)
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
For i = CInt(nupDepth.Value) To 0 Step -1
g.DrawString(TextBox1.Text, fnt, back_brush, location_x - i, location_y + i)
Next
g.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
End Using
PictureBox2.Image = bmp
Note: Always remember to dispose the created Graphics object when you finish using it either by calling .Dispose() or by wrapping it in a Using statement like what I did above.
Instead of
Clipboard.SetDataObject(DirectCast(PictureBox2.Image.Clone, Bitmap), True)
Use
Clipboard.SetDataObject(PictureBox2.Image, 2)
I am trying to resize/ re-position controls based on the size of the form. This is the class i am using :
Public Class Resizer
'----------------------------------------------------------
' ControlInfo
' Structure of original state of all processed controls
'----------------------------------------------------------
Private Structure ControlInfo
Public name As String
Public parentName As String
Public leftOffsetPercent As Double
Public topOffsetPercent As Double
Public heightPercent As Double
Public originalHeight As Integer
Public originalWidth As Integer
Public widthPercent As Double
Public originalFontSize As Single
End Structure
'-------------------------------------------------------------------------
' ctrlDict
' Dictionary of (control name, control info) for all processed controls
'-------------------------------------------------------------------------
Private ctrlDict As Dictionary(Of String, ControlInfo) = New Dictionary(Of String, ControlInfo)
'----------------------------------------------------------------------------------------
' FindAllControls
' Recursive function to process all controls contained in the initially passed
' control container and store it in the Control dictionary
'----------------------------------------------------------------------------------------
Public Sub FindAllControls(thisCtrl As Control)
'-- If the current control has a parent, store all original relative position
'-- and size information in the dictionary.
'-- Recursively call FindAllControls for each control contained in the
'-- current Control
For Each ctl As Control In thisCtrl.Controls
Try
If Not IsNothing(ctl.Parent) Then
Dim parentHeight = ctl.Parent.Height
Dim parentWidth = ctl.Parent.Width
Dim c As New ControlInfo
c.name = ctl.Name
c.parentName = ctl.Parent.Name
c.topOffsetPercent = Convert.ToDouble(ctl.Top) / Convert.ToDouble(parentHeight)
c.leftOffsetPercent = Convert.ToDouble(ctl.Left) / Convert.ToDouble(parentWidth)
c.heightPercent = Convert.ToDouble(ctl.Height) / Convert.ToDouble(parentHeight)
c.widthPercent = Convert.ToDouble(ctl.Width) / Convert.ToDouble(parentWidth)
c.originalFontSize = ctl.Font.Size
c.originalHeight = ctl.Height
c.originalWidth = ctl.Width
ctrlDict.Add(c.name, c)
End If
Catch ex As Exception
Debug.Print(ex.Message)
End Try
If ctl.Controls.Count > 0 Then
FindAllControls(ctl)
End If
Next '-- For Each
End Sub
'----------------------------------------------------------------------------------------
' ResizeAllControls
' Recursive function to resize and reposition all controls contained in the Control
' dictionary
'----------------------------------------------------------------------------------------
Public Sub ResizeAllControls(thisCtrl As Control, Optional wform As Form = Nothing)
Dim fontRatioW As Single
Dim fontRatioH As Single
Dim fontRatio As Single
Dim f As Font
If IsNothing(wform) = False Then wform.Opacity = 0
'-- Resize and reposition all controls in the passed control
For Each ctl As Control In thisCtrl.Controls
Try
If Not IsNothing(ctl.Parent) Then
Dim parentHeight = ctl.Parent.Height
Dim parentWidth = ctl.Parent.Width
Dim c As New ControlInfo
Dim ret As Boolean = False
Try
'-- Get the current control's info from the control info dictionary
ret = ctrlDict.TryGetValue(ctl.Name, c)
'-- If found, adjust the current control based on control relative
'-- size and position information stored in the dictionary
If (ret) Then
'-- Size
ctl.Width = Int(parentWidth * c.widthPercent)
ctl.Height = Int(parentHeight * c.heightPercent)
'-- Position
ctl.Top = Int(parentHeight * c.topOffsetPercent)
ctl.Left = Int(parentWidth * c.leftOffsetPercent)
'-- Font
f = ctl.Font
fontRatioW = ctl.Width / c.originalWidth
fontRatioH = ctl.Height / c.originalHeight
fontRatio = (fontRatioW +
fontRatioH) / 2 '-- average change in control Height and Width
ctl.Font = New Font(f.FontFamily,
c.originalFontSize * fontRatio, f.Style)
End If
Catch
End Try
End If
Catch ex As Exception
End Try
'-- Recursive call for controls contained in the current control
If ctl.Controls.Count > 0 Then
ResizeAllControls(ctl)
End If
Next '-- For Each
If IsNothing(wform) = False Then wform.Opacity = 1
End Sub
End Class
The problem with this code is that
1) It flickers a lot while resizing the controls or moving them around.
2) Some labels and buttons are moved around to random positions on the form and,
3) the size of the background image is not responsive to the size of the form (Not much knowledge on how to execute this.)
Any sort of help is appreciated.
Instead of manually doing this, look into properties on the form such as "Dock", "Anchor".
Examples:
Setting dock to top (or bottom) will allow a module to always cover
the entire top (or bottom) of the form, keeping the height the same.
Setting dock to left (or right) will allow a module to always cover the entire left (or right) of the form, keeping the height the
same.
Setting the anchor property to all of Top, Left, Right, Down will allow the control to expand as the form grows, but keep it's x/y top-left position.
Setting the anchor property to Top, Left, Right will allow the control to expand to the right as the form grows, but keep it's x/y top-left position
Setting the anchor property to Bottom, Right will allow the control to stay in a fixed position relative to the bottom corner of the form.
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
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