Public Class frmLupe
 
    Dim fc As Double = 4
 
    Dim pb As New PictureBox With {.Parent = Me, .Dock = DockStyle.Fill,
        .BackColor = Color.White, .SizeMode = PictureBoxSizeMode.Zoom}
    Dim bmp As Bitmap
    Dim WithEvents timCopy As New Timer With {.Interval = 500, .Enabled = True}
 
    Public RTBtoShow As RichTextBox
 
 
    Private Sub timCopy_Tick(sender As Object, e As EventArgs) Handles _
      timCopy.Tick
 
        If RTBtoShow Is Nothing Then
            ShowScreen()
        Else
            ShowRichText()
        End If
    End Sub
 
 
    Private Sub ShowScreen()
 
        Dim sz As Size = GetAreaSize()
 
        Dim mt As Integer = Me.MousePosition.Y
        Dim ml As Integer = Me.MousePosition.X
 
        mt = Math.Max(0, mt - sz.Height \ 2)
        ml = Math.Max(0, ml - sz.Width \ 2)
 
        SetBitmap(New Point(ml, mt), sz)
    End Sub
 
 
    Private Function GetAreaSize() As Size
 
        Return New Size(pb.Width / fc, pb.Height / fc)
    End Function
 
 
    Private Sub SetBitmap(pos As Point, sz As Size)
 
        If Size.Height < 5 Then Return
 
        If bmp IsNot Nothing Then
            bmp.Dispose()
            bmp = Nothing
        End If
 
        bmp = New Bitmap(sz.Width, sz.Height)
        Using g As Graphics = Graphics.FromImage(bmp)
            g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
            g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
 
            g.CopyFromScreen(pos, New Point(0, 0), sz)
        End Using
        pb.Image = bmp
 
    End Sub
 
 
    Private Sub ShowRichText()
 
        Dim sz As Size = GetAreaSize()
 
        Dim sp As Point
        With RTBtoShow
            sp =
            .PointToScreen(.GetPositionFromCharIndex(.SelectionStart))
        End With
 
        Dim ct As Integer = Math.Max(0, sp.Y - sz.Height \ 2)
        Dim cl As Integer = Math.Max(0, sp.X - sz.Width \ 2)
 
        SetBitmap(New Point(cl, ct), sz)
 
    End Sub
 
End Class