How to resize the Picturebox so it can show the full image if the image size is less than monitor size ! I wrote a code which can not resize (but still posting the code)!
Code before loading image on a button click
Dim bmp As Bitmap
bmp = New Bitmap(path)
If bmp.Width < picBox.Image.Width Then picBox.Width = bmp.Width : If bmp.Height < picBox.Image.Height Then picBox.Height = bmp.Height
picBox.Invalidate() : picBox.Refresh()
'picBox.SetBounds(x,y,width,height)
The code does not resize the picturebox, it's just untouched !
Edit
The form has the picBox and a groupbox [dock enabled] control only.
bmp = New Bitmap(dlgOpen.FileName)
picBox.SizeMode = PictureBoxSizeMode.Normal
Dim w As Integer = picBox.ClientSize.Width
Dim h As Integer = picBox.ClientSize.Height
If bmp.Width > w Then
w = bmp.Width
End If
If bmp.Height > h Then
h = bmp.Height
End If
If w > Me.Width - grpBox.Width Then
w = Me.Width - grpBox.Width
End If
If h > grpBox.Height Then
h = grpBox.Height
End If
picBox.ClientSize = New Size(w, h)
picBox.ImageLocation = dlgOpen.FileName
This code does not re-sizes the picture box either .
In .NET, there's the Public Enumeration PictureBoxSizeMode that allows you to change how the PictureBox handles differently sized images:
Normal
StretchImage
AutoSize
CenterImage
Zoom
You can set it for the current PictureBox via the .SizeMode property. AutoSize is probably what you are looking for. If it is larger than the window or frame, you will have to handle this in a PictureBox.Resize event to either resize the window or rescale the image.
So, it might be something like:
Dim bmp As Bitmap
bmp = New Bitmap(path)
picBox.SizeMode = PictureBoxSizeMode.AutoResize
picBox.Image = bmp
Dim bmp As New Bitmap(path)
PictureBox1.SizeMode = PictureBoxSizeMode.Normal
Dim w As Integer = PictureBox1.ClientSize.Width
Dim h As Integer = PictureBox1.ClientSize.Height
If bmp.Width > w Then
w = bmp.Width
End If
If bmp.Height > h Then
h = bmp.Height
End If
If w > maxWidth Then
w = maxWidth
End If
If h > maxHeight Then
h = maxHeight
End If
PictureBox1.ClientSize = New Size(w, h)
PictureBox1.Image = bmp
Picture-box can be re-sized only before loading the image, there after it is read only and has no effect !
Related
a strange phenomenon occurs.
With my edge detection program, I can transfer the inside of the GraphicsPath to a new image.
It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.
Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).
I just realized: if I scale an image larger, the result is completely black.
The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.
I would be happy if someone could tell me why. 😄
this is the scaled image which is loaded
Here you see the GUI, ready to save
cropped image, area has x and y offset
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class AllesGrafische
Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
If g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawRectangle(Pen_Hellblau, recta)
End Using
End If
End Sub
Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Dim theList_neu As New List(Of Point)
Using gp As New GraphicsPath
For i As Integer = 1 To theList.Count - 1 Step 1
Dim a As Integer = theList(i).X
Dim b As Integer = theList(i).Y
Dim c As Integer = theList(i - 1).X
Dim d As Integer = theList(i - 1).Y
Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
theList_neu.Add(theList(i))
End If
Next
If theList_neu.Count = 0 Then Return
gp.AddLines(theList_neu.ToArray())
Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
g.DrawPath(Pen_hellrosa, gp)
End Using
If Form1.ClosePath Then
gp.CloseFigure()
End If
If Form1.CheckBox1.Checked Then
Dim Speicherpfad As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "Wo soll das Bild gespeichert werden?"
SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
Else
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
End If
If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
Speicherpfad = SFD1.FileName & ".png"
Else
Return
End If
End Using
Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As Matrix = New Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
graphicsCutout.Clip = New Region(gp)
graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
Form1.CheckBox1.Checked = False
End Using
End Using
End Using
End If
End Using
End If
End Sub
End Class
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
The solution is to use .SetResolution()
Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.
I have some images of document and book covers and those are displayed using pictureboxes in a Table layout panel.
Image excerpt from winform app
I am following this code
(From: https://social.msdn.microsoft.com/Forums/vstudio/en-US/da545e8e-e059-4681-9893-6d5dbdf6eba6/drop-shadow-around-the-image-in-picturebox?forum=vbgeneral)
to make picturebox work as a button when clicked and open the desired book or document.
Public Enum ShadowPosition As Integer
TopLeft = 0
TopRight = 1
BottomLeft = 2
BottomRight = 3
End Enum
Private Sub AddImageWithShadow(ByVal img As System.Drawing.Image, ByVal area As ShadowPosition, ByVal thickness As Integer, ByVal clr As Color, ByVal PicBox As PictureBox)
Using bm As New Bitmap(img.Width + thickness, img.Height + thickness)
Using gr As Graphics = Graphics.FromImage(bm)
Dim ix, iy As Integer
Dim rect As New Rectangle(thickness, thickness, img.Width, img.Height)
If area = ShadowPosition.TopLeft Or area = ShadowPosition.TopRight Then
iy = thickness
rect.Y = 0
End If
If area = ShadowPosition.TopLeft Or area = ShadowPosition.BottomLeft Then
ix = thickness
rect.X = 0
End If
gr.FillRectangle(New SolidBrush(clr), rect)
gr.DrawImage(img, ix, iy)
End Using
If PicBox.Image IsNot Nothing Then PicBox.Image.Dispose()
PicBox.Image = New Bitmap(bm)
End Using
End Sub
I tried to change the position of image:
Picturebox1.Location = New Point(10, 10)
Is there a way someone could guess to redarw picturebox at some offset without its drop shadow and back to initial state.
For my student project, I’ve a vb.net code snippet that downloads a jpg file from a website and then sets all its pixels, which are almost white, entirely white:
Dim oColor As Color
Dim bRed As Byte
Dim bGreen As Byte
Dim bBlue As Byte
Dim imgTemp As Image = Image.FromFile("C:\DownloadedImage.jpg")
Dim bmpTemp As New Bitmap(imgTemp.Width, imgTemp.Height, Imaging.PixelFormat.Format32bppArgb)
Using gfx As Graphics = Graphics.FromImage(bmpTemp)
gfx.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
gfx.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
gfx.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
gfx.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
gfx.DrawImage(imgTemp, 0, 0)
End Using
For x = 0 To bmpTemp.Width - 1
For y = 0 To bmpTemp.Height - 1
oColor = bmpTemp.GetPixel(x, y)
bRed = oColor.R
bGreen = oColor.G
bBlue = oColor.B
If bRed <= 254 AndAlso bRed >= 254 - 20 Then '20 = White Tolerance'
bmpTemp.SetPixel(x, y, Color.White)
End If
If bGreen <= 254 AndAlso bGreen >= 254 - 20 Then
bmpTemp.SetPixel(x, y, Color.White)
End If
If bBlue <= 254 AndAlso bBlue >= 254 - 20 Then
bmpTemp.SetPixel(x, y, Color.White)
End If
Next
Next
Dim newForm As New Form With {.BackgroundImage = bmpTemp, .TransparencyKey = Color.White, .BackgroundImageLayout = ImageLayout.Zoom, .BackColor = Color.White}
newForm.Show()
The bitmap created in this way is then set as the BackgroundImage of a form whose TransparencyKey property is white. The result is not a complete failure, but the edges of the isolated object are still white and pixelated:
The result in two different sizes (left) and what I'm trying to achieve (right)
I’m now looking for a way to get rid of those ragged edges, something like Photoshop’s “Refine Edge” function.
Many thanks in advance!
I have been working on an app to search for 3 pixels in a certain area then play a sound. It currently works however I wish to reduce the zone of which it searches from the whole screen to a rectangular area on my screen, this is to save memory usage of the app, here's the code that works
Private Sub dcdTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dcdTimer.Tick
Dim screensize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim screenshot As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
Dim pointx As Integer = 1
Dim pointy As Integer = 1
ge.CopyFromScreen(New Point(0, 0), New Point(0, 0), screensize)
looking = True
Try
While looking = True
Dim atpoint As Color = screenshot.GetPixel(pointx, pointy)
Dim reckcol1 As Color = Color.FromArgb(a, r, g, b) 'first pixel colour
Dim reckcol2 As Color = Color.FromArgb(a1, r1, g1, b1) 'second pixel colour
Dim reckcol3 As Color = Color.FromArgb(a2, r2, g2, b2) 'third pixel colour
If atpoint = reckcol1 Then 'Matches 3 pixels
Dim testPoint As Color = screenshot.GetPixel(pointx, pointy + 10)
If testPoint = reckcol2 Then
Dim testPoint2 As Color = screenshot.GetPixel(pointx + 10, pointy + 10)
If testPoint2 = reckcol3 Then
My.Computer.Audio.Play(sounddir + "Found.wav")
looking = False
Sleep(15000)
pointx = 0
pointy = 0
End If
End If
End If
pointy = pointy + 1
If pointy = My.Computer.Screen.Bounds.Height Then
pointy = 0
pointx = pointx + 1
End If
End While
Catch ex As Exception
End Try
End Sub
I tried to use this code as suggested:
Dim pointofY As New Point(500, 400)
Dim screensize As New Size(400, 200)
Dim screenshot As New Rectangle(pointofY, screensize)
Dim ge As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(screenshot)
However, using a rectangle does not allow me to use getpixel or use ge.copyfromscreen
I have my pixBox1 which is fix, and unable to change the image
and pixBox2 is not fix which can change there color and rotate in here
i use OpenFileDialog function to put image inside those pixbox
so now how can i combine those two pixbox into my pixbox3?
i try this but it doesn't look like it's going to work:
Dim image As New Bitmap(pixBox1.Image)
Dim image2 As New Bitmap(pixBox2.Image)
Dim Image3 As New Bitmap(300, 300)
Dim g As Graphics = Graphics.FromImage(Image3)
g.DrawImage(image1, New Point(300, 300))
g.DrawImage(image2, New Point(300, 300))
g.Dispose()
g = Nothing
pixBox3.Image = Image3
This is kinda ugly and slow, but it basically sets all the pixels in image2 to be 50% transparent then draws it over the top of Image.
Dim image As New Bitmap(pixBox1.Image)
Dim image2 As New Bitmap(pixBox2.Image)
Dim Image3 As New Bitmap(300, 300)
Using g As Graphics = Graphics.FromImage(Image3)
'make 2nd bmp translucent
For Integer Xcount = 0 To image2.Width - 1
For Integer Ycount = 0 To image2.Height - 1
Dim c as Color = image2.GetPixel(Xcount, Ycount)
c = Color.FromARGB(125, c.R, c.G, c.B) '50% alpha
image2.SetPixel(Xcount, Ycount, c)
Next
Next
g.DrawImage(image1, New Point(0, 0))
g.DrawImage(image2, New Point(0, 0))
End Using
pixBox3.Image = Image3
As a side note, the Using block makes sure g is disposed no matter what happens.