Dim cbo As New ComboBox With _
{.Parent = Me, .Width = 50, .DropDownWidth = 20, .DropDownStyle = _
ComboBoxStyle.DropDownList}

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}
 
    Private Sub timCopy_Tick(sender As Object, e As EventArgs) Handles _
      timCopy.Tick
 
        'Aktuelle Größe der Lupe
        Dim w As Integer = pb.Width
        Dim h As Integer = pb.Height
 
        'Größe des darstellbaren Bildschirmabschnitts
        Dim sw As Integer = w / fc
        Dim sh As Integer = h / fc
 
        'Position des Bildschirmabschnitts gemäß Mausposition 
        Dim mt As Integer = Me.MousePosition.Y
        Dim ml As Integer = Me.MousePosition.X
        mt = Math.Max(0, mt - sh \ 2)
        ml = Math.Max(0, ml - sw \ 2)
 
        If bmp IsNot Nothing Then
            bmp.Dispose()
            bmp = Nothing
        End If
 
        bmp = New Bitmap(sw, sh)
        Using g As Graphics = Graphics.FromImage(bmp)
            'Kopieren des Bildschirmabschnitts in die Bitmap
            g.CopyFromScreen(New Point(ml, mt), New Point(0, 0), New _
              Drawing.Size(sw, sh))
            'Anzeigen
            pb.Image = bmp
        End Using
 
    End Sub
End Class

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

 Public GridtoShow As DataGridView
 
 Private Sub timCopy_Tick(sender As Object, e As EventArgs) Handles timCopy.Tick
 
        If RTBtoShow IsNot Nothing Then
            ShowRichText()
        ElseIf GridtoShow IsNot Nothing Then
            ShowGrid()
        Else
            ShowScreen()
        End If
 End Sub

  Private Sub ShowGrid()
 
        Dim sz As Size = GetAreaSize()
 
        Dim sp As Point
        With GridtoShow
            Dim r As Rectangle = 
            .GetCellDisplayRectangle(.CurrentCell.ColumnIndex, _
              .CurrentCell.RowIndex, True)
 
            sp = .PointToScreen(r.Location)
        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

Private Declare Function GetCaretPos Lib "user32" (ByRef lpPoint As Point) As _
  Integer
 
Public Texttoshow As TextBox
 
 
Private Sub ShowText()
 
    Dim sz As Size = GetAreaSize()
 
    Dim tp As Point
    Dim ret As Integer = GetCaretPos(tp)
    Dim sp As Point
    sp = Texttoshow.PointToScreen(tp)
 
    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