Redraw Picturebox at offset and back to simulate as a button effect - vb.net

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.

Related

The cropping area has an x and y offset in the new bitmap, but only if the original has been scaled

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

What Is The Best Way To Animate A Panel Container Opening And Closing (With Added Controls)

I am trying to create an animated collapsible panel that consists of three different elements. Each element is created from a panel container that sits on a user control. It is made up of a header panel, a content panel and a footer panel (with the footer panel sitting inside the content panel):
Within each panel I override the draw event and do my own custom drawing. This includes rounding the corners, drawing a border, and filling the background (and drawing text in the cases of the header and footer).
The control also allows users to embed into the content panel at both design time and runtime.
When placed on a form, it looks exactly how I want it to, however, I cannot seem to animate the panel in a seamless 'smooth' transition. It is jerky, jittery and looks horrendous when expanding the panel (even with no content).
The way it should work is that when minimized, the content panel (including the footer panel) shrinks to only be the height of the header panel. The header panel then redraws itself to look different. Then when maximized, the panel basically does everything in reverse.
My animation code looks like such:
Dim m_Height As Integer = Me.Height
Dim m_HeaderHeight As Integer = 40
Dim m_FooterHeight As Integer = 35
Dim ShrinkStepSize As Integer = CInt((m_Height - m_HeaderHeight) / 10)
Dim ExpandStepSize As Integer = CInt((m_Height - m_HeaderHeight) / 4)
Private Sub picMinimize_Click(sender As Object, e As EventArgs) Handles picMinimize.Click
While (Me.Height > m_HeaderHeight)
Me.Height -= Math.Min(Me.Height - m_HeaderHeight, ShrinkStepSize)
Application.DoEvents()
End While
picMaximise.Visible = True
picMinimize.Visible = False
m_Minimized = True
Me.Invalidate(pnlHeader.ClientRectangle, True)
End Sub
Private Sub picMaximise_Click(sender As Object, e As EventArgs) Handles picMaximise.Click
While (Me.Height < m_Height)
Me.Height += Math.Min(m_Height - Me.Height, ExpandStepSize)
Application.DoEvents()
End While
picMaximise.Visible = False
picMinimize.Visible = True
m_Minimized = False
Me.Invalidate(pnlHeader.ClientRectangle, True)
End Sub
And without posting all of my code (unless it's required), here are all my paint events for the header, content and footer panels:
Private Sub pnlHeader_Paint(sender As Object, e As PaintEventArgs) Handles pnlHeader.Paint
Dim rect As Rectangle = pnlHeader.ClientRectangle
rect.X = rect.X + 1
rect.Y = rect.Y + 1
rect.Width -= 2
rect.Height -= 2
'Position the icon elements
picClose.Location = New Point(rect.Width - (picClose.Width + 8), CInt(((rect.Height - picClose.Height) / 2) + 3))
picOptions.Location = New Point(rect.Width - ((picClose.Width + picOptions.Width) + 10), CInt(((rect.Height - picOptions.Height) / 2) + 2))
picMinimize.Location = New Point(rect.Width - ((picMinimize.Width + picOptions.Width + picClose.Width) + 15), CInt(((rect.Height - picMinimize.Height) / 2) + 3))
picMaximise.Location = New Point(rect.Width - ((picMaximise.Width + picOptions.Width + picClose.Width) + 15), CInt(((rect.Height - picMaximise.Height) / 2) + 3))
Dim path As Drawing2D.GraphicsPath = RoundRectangle(rect, CornerRadius, Me.CornerRounding)
If m_Minimized Then
'Draw the background
Using br As Brush = New SolidBrush(Color.White)
e.Graphics.FillPath(br, path)
End Using
'Draw the border
Using br As Brush = New SolidBrush(BorderColour)
e.Graphics.DrawPath(New Pen(br, 1), path)
End Using
End If
'Draw the text
Dim textRect As Rectangle = rect
textRect.X += m_HeaderAdjustment
Using string_format As New StringFormat()
string_format.Alignment = StringAlignment.Near
string_format.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(HeaderText, New Font("Segoe UI", 13, FontStyle.Bold, GraphicsUnit.Pixel), New SolidBrush(Color.FromArgb(157, 159, 162)), textRect, string_format)
End Using
End Sub
Private Sub pnlContent_Paint(sender As Object, e As PaintEventArgs) Handles pnlContent.Paint
Dim rect As Rectangle = pnlContent.ClientRectangle
rect.X = rect.X + 1
rect.Y = rect.Y + 1
rect.Width -= 2
rect.Height -= 2
Dim path As Drawing2D.GraphicsPath = RoundRectangle(rect, CornerRadius, Me.CornerRounding)
'Draw the background
Using br As Brush = New SolidBrush(Color.White)
e.Graphics.FillPath(br, path)
End Using
'Draw the border
Using br As Brush = New SolidBrush(BorderColour)
rect.Inflate(-1, -1)
e.Graphics.DrawPath(New Pen(br, 1), path)
End Using
End Sub
Private Sub pnlFooter_Paint(sender As Object, e As PaintEventArgs) Handles pnlFooter.Paint
Dim rect As Rectangle = pnlFooter.ClientRectangle
rect.X = rect.X + 1
rect.Y = rect.Y + 1
rect.Width -= 2
rect.Height -= 2
Dim rounding As Corners = Corners.BottomLeft Or Corners.BottomRight
Dim path As Drawing2D.GraphicsPath = RoundRectangle(rect, CornerRadius, rounding)
'Draw the background
Using br As Brush = New SolidBrush(FooterBackColour)
e.Graphics.FillPath(br, path)
End Using
'Draw the border
Using br As Brush = New SolidBrush(BorderColour)
e.Graphics.DrawPath(New Pen(br, 1), path)
End Using
'Draw the text
Dim textRect As Rectangle = rect
textRect.X += m_FooterAdjustment
textRect.Y += 1
Using string_format As New StringFormat()
string_format.Alignment = StringAlignment.Near
string_format.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(FooterText, New Font("Segoe UI", 11, FontStyle.Regular, GraphicsUnit.Pixel), New SolidBrush(FooterForeColour), textRect, string_format)
End Using
End Sub
Any help with this would be greatly appreciated.
Thanks heaps.

Saving a Drawing but not a Full Image in VB.net

I'm working on making a paint-esq image manipulator in VB.Net, and I'm still new to vb. I want the user to be able to upload an image and make adjustments to it, such as adding lines and text. I also want the user to be able to transfer the drawings and text they added to a different baseimage. For example, if the user draws a dog on top of a picture of a park, they can change it so the dog is on a street instead.
I've been messing with the idea of loading the image as the picturebox.backgroundImage, but running into difficulties changing the backgroundImage without reseting the drawings and with croping the image. I've also been dabling in having two pictureboxes with the one on top for drawings, but I'm running into transparency and cropping issues
Here is the code I'm using to establish my picturebox by setting the base image as .backgroundImage
Private Sub LoadImage(thisImage As Image)
'we set the picturebox size according to image, we can get image width and height with the help of Image.Width and Image.height properties.
img.BackgroundImage = thisImage 'c'
img.Image = New Bitmap(thisImage.Width, thisImage.Height) 'c'
img.BorderStyle = BorderStyle.FixedSingle
End Sub
example of the image maniputlation
Private Sub ButtonDone_Click(sender As Object, e As EventArgs) Handles ButtonDone.Click, DoneToolStripMenuItem.Click
Cursor = Cursors.Default
Select Case LCase(stateFlag)
Case "header"
'Reset stuff back to normal
ButtonHeader.Text = "Header"
stateFlag = ""
Cancel_Button.Enabled = False
'set up space to draw on the image
Dim newBm As New Bitmap(img.Image.Width, img.Image.Height)
' First we define a rectangle with the help of already calculated points
Dim newGraphics As Graphics = Graphics.FromImage(newBM) ' create graphics
newGraphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
newGraphics.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
newGraphics.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
'set image attributes
newGraphics.DrawImage(img.Image, New Rectangle(0, 0, img.Image.Width + 1, img.Image.Height + 1), _
0, 0, img.Image.Width + 1, img.Image.Height + 1, GraphicsUnit.Pixel)
'Draw Edges for header
newGraphics.DrawLine(Pens.Black, startPoint.X, borderSize - 20, startPoint.X, borderSize - 50)
newGraphics.DrawLine(Pens.Black, endPoint.X, borderSize - 20, endPoint.X, borderSize - 50)
Dim drawFont As New Font("Times New Roman", 12)
Dim drawBrush As New SolidBrush(Color.Black)
Dim stringSize As SizeF = newGraphics.MeasureString(HeaderLabel.Text, drawFont)
' Draw header label inbetween the two edges.
newGraphics.DrawString(HeaderLabel.Text, drawFont, drawBrush, (startPoint.X + endPoint.X) / 2 - (stringSize.Width / 2), borderSize - 45)
img.Image = newBm
PushUndo(img.Image.Clone)
End Sub
I would advise trying the following method to use one picturebox on top of the other, it is a lot simpler than some other methods. In your form load handler, do something like:
pctBackground.BackgroundImage = Bitmap.FromFile("park.jpg")
pctForeground.BackColor = Color.Transparent
pctForeground.Parent = pctBackground
pctForeground.Image = New Bitmap(pctForeground.ClientSize.Width, pctForeground.ClientSize.Height)
Then when you have drawn on the pctForeground, save it like:
pctForeground.Image.Save("dog_in_park.png", System.Drawing.Imaging.ImageFormat.Png)

Changing the area of a pixel search

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

Resize PictureBox to match image size

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 !