Hello!
This is a magnifying glass simulation.
I tried doing it on a label, but when drawing a graphics on a label, there are empty areas on top and left of the label that will increase with every capture, so I used a Picturebox instead.
Here are a couple of views:
This is what I did:
There are 3 pictureboxes on the form. The one with the screw chart is just decoration, and to show how the magnifying area appears on top of controls and then dissapears, restoring the view.
The two important ones are the one with the graphics we are to magnify, in this case, an engine, and another, that is invisible, and that appears when the mouse enters the main picturebox.
Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class Form1
Dim Ratio As Single
Dim R As Rectangle = New Rectangle(0.0F, 0.0F, 220.0F, 220.0F) 'Square
Dim cpen As New Pen(Color.Black, 3)
Dim Backup As Image
Dim W, H As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
W = pb_Preview.Image.Width
H = pb_Preview.Image.Height
Ratio = CSng(W / H) 'Initial Ratio to keep proportion
pb_Preview.Height = 220 'Defined Height for The scrolling image
pb_Preview.Width = CInt(220 * Ratio)
End Sub
Private Sub pb_review_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles pb_Preview.MouseEnter
'Capture Area of Screen To hide perifery of circle on picturebox
Dim fX, fY As Integer
fX = Me.ClientRectangle.Left
fY = Me.ClientRectangle.Top
Dim startPoint As Point = pb_Zoom.PointToScreen(New Point(0, 0))
Dim G As Graphics = Me.CreateGraphics
Dim Position As New Point(fX + pb_Zoom.Left, fY + pb_Zoom.Top)
Dim screenGrab As New Bitmap(pb_Preview.Image.Width, pb_Preview.Image.Height, Imaging.PixelFormat.Format32bppArgb)
G = Graphics.FromImage(screenGrab)
G.CopyFromScreen(startPoint, New Point(0, 0), pb_Zoom.Size, CopyPixelOperation.SourceCopy)
pb_Zoom.Image = screenGrab
pb_Zoom.BringToFront()
pb_Zoom.Visible = True
End Sub
And disappears on leaving:
Private Sub pb_Preview_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles pb_Preview.MouseLeave
pb_Zoom.Visible = False
Me.Refresh() 'restore views when leaving area
End Sub
When the mouse is on the picturebox and moves, an area of the picturebox is clipped to the captured image on the invisible picturebox.
Drawing a circle on black and 3 pixels thick.
Dim cpen As New Pen(Color.Black, 3)
Private Sub PictureBox2_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pb_Preview.MouseMove
Dim G As Graphics = Graphics.FromImage(pb_Zoom.Image) 'Picturebox1.CreateGraphics
Dim path As New GraphicsPath()
Dim L, T As Integer
'Left and Top of magnifying area
L = pb_Zoom.Width / 2 + (e.X * pb_Preview.Image.Width) / pb_Preview.Width
T = pb_Zoom.Height / 2 + pb_Preview.Height - (e.Y * pb_Preview.Image.Height) / pb_Preview.Height
path.AddEllipse(R)
G.DrawPath(cpen, path)
G.SetClip(path, CombineMode.Replace) ' Clip Magnifying area to screen capture
G.DrawImage(pb_Preview.Image, pb_Preview.Width - L, T - pb_Preview.Height, pb_Preview.Image.Width, pb_Preview.Image.Height)
pb_Zoom.Refresh()
End Sub
If you load and image from the computer, the dimensions are saved in' W' and' H' and the size is adjusted to 220 pixels high, and corresponding proportional width, so the image is not deformed.
Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
Dim f As New OpenFileDialog
Dim NewWidth, NewHeight As Integer
Try
With f
.Filter = "Image Files|*.bmp;*.gif;*.jpg;*.png;*.tif"
If .ShowDialog = DialogResult.OK Then
pb_Preview.Image = Image.FromFile(.FileName)
'Dimensions of new loaded image
W = pb_Preview.Image.Width
H = pb_Preview.Image.Height
Ratio = CSng(W / H)
NewWidth = CInt(220 * Ratio)
NewHeight = 220
pb_Preview.Height = 220
pb_Preview.Width = NewWidth
End If
End With
Catch ex As Exception
MsgBox(ex.ToString)
Finally
If Not f Is Nothing Then
f.Dispose()
f = Nothing
End If
End Try
End Sub
This is a pseudo magnification, because I am shrinking the original image, so the magnification will depend on the height of the original image divided by 220.
For real magnification you will need to create a bitmap and use graphics, like this:
Private Function ShrinkImage(ByVal from_pic As Image, ByVal hgt As Integer, Optional ByVal anti_alias As _
Boolean = False) As Image
' Get the source Bitmap.
Dim from_bm As New Bitmap(from_pic)
' Make the destination Bitmap.
Dim wid As Integer = CInt(PictureBox1.Width * hgt / PictureBox1.Height) 'from_pic.Width / 2
If CheckBox7.Checked = True Then
Dim to_bm As New Bitmap(wid, hgt, Imaging.PixelFormat.Format24bppRgb)
Dim gr As Graphics = Graphics.FromImage(to_bm)
' Copy the image.
If anti_alias Then gr.InterpolationMode = _
Drawing2D.InterpolationMode.HighQualityBilinear
gr.DrawImage(from_bm, 0, 0, wid - 1, hgt - 1)
' Display the result.
' to_pic.Image = to_bm
gr.Dispose()
Return to_bm
Else
Dim to_bm As New Bitmap(wid, hgt)
Dim gr As Graphics = Graphics.FromImage(to_bm)
' Copy the image.
If anti_alias Then gr.InterpolationMode = _
Drawing2D.InterpolationMode.HighQualityBilinear
gr.DrawImage(from_bm, 0, 0, wid - 1, hgt - 1)
' Display the result.
' to_pic.Image = to_bm
gr.Dispose()
Return to_bm
End If
End Function
This function can be used to increse or decrease the size, but it is not used in this program.
Attached is a project. Please Give it a try!
Thank you.
ricardosms
Attached File(s)
-
Glass.zip (840.83K)
Number of downloads: 651
MultiQuote
| 