Page 1 of 1

Magnifying Glass With Screen Capture And Clipping Rate Topic: -----

#1 ricardosms  Icon User is offline

  • D.I.C Regular
  • member icon

Reputation: 73
  • View blog
  • Posts: 301
  • Joined: 02-April 10

Posted 14 November 2011 - 08:14 PM

Magnifying Glass With Screen Capture And Clipping

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:

Attached Image

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)

  • Attached File  Glass.zip (840.83K)
    Number of downloads: 847


Is This A Good Question/Topic? 4
  • +

Replies To: Magnifying Glass With Screen Capture And Clipping

#2 ricardosms  Icon User is offline

  • D.I.C Regular
  • member icon

Reputation: 73
  • View blog
  • Posts: 301
  • Joined: 02-April 10

Posted 17 November 2011 - 07:53 PM

Just a quick note:

I used a circle to imitate a magnifying glass, but you could use any kind of path, string or irregular drawn path. That could give access to irregular shapes or transparent areas.
Was This Post Helpful? 1
  • +
  • -

#3 TechKid  Icon User is offline

  • D.I.C Head
  • member icon

Reputation: 3
  • View blog
  • Posts: 82
  • Joined: 04-September 10

Posted 25 November 2012 - 09:21 AM

This is absolutely amazing, great job once again! You're a beast :)
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1