Public Sub Pic8IndexedCut(ByVal Bilddatei_in As String, _
                          ByVal Bilddatei_out As String, _
                 Optional ByVal cutrectangle As Rectangle = Nothing)
 
    Dim x, y As Integer ' Loop
    Dim Byte_In_Index, Byte_Out_Index As Integer
 
    If IO.Path.GetExtension(Bilddatei_out).ToUpper <> ".TIF" Then
            Throw New ArgumentException _
                      ("Ausgabedatei: keine TIF-Extension")
    End If
 
    ' Bitmap aus Datei laden
    Dim bmp_in As New Drawing.Bitmap(Bilddatei_in)
    If bmp_in.PixelFormat <> Imaging.PixelFormat.Format8bppIndexed Then
       Throw New ArgumentException _
               ("Quelldatei liefert keine 8BitIndexed-Bitmap")
    End If
 
    If cutrectangle = Nothing Then
       cutrectangle = New Rectangle _
                (0, 0, bmp_in.Width, bmp_in.Height)
    End If
 
    With cutrectangle
       If .Left < 0 Or .Top < 0 Or .Left + .Width > bmp_in.Width Or _
          .Top + .Height > bmp_in.Height Then
          Throw New ArgumentException _
                  ("Ausschnitt-Rechteck ausserhalb Quell-Bitmap")
       End If
    End With
 
    Dim bmp_in_data As New Imaging.BitmapData, bmp_in_array(0) As Byte
    Dim bmp_in_ptr As IntPtr = LockBits(bmp_in, bmp_in_data, bmp_in_array)
 
    ' Die Bitmapdaten in das Array kopieren
    Runtime.InteropServices.Marshal.Copy _
            (bmp_in_ptr, bmp_in_array, 0, bmp_in_array.Length)
 
    'Ausgabe-Bitmap für Ausschnitt erstellen
    Dim bmp_out As New Bitmap _
         (cutrectangle.Width, cutrectangle.Height, bmp_in.PixelFormat)
 
    Dim bmp_out_data As New Imaging.BitmapData, bmp_out_array(0) As Byte
    Dim bmp_out_ptr As IntPtr = LockBits _
            (bmp_out, bmp_out_data, bmp_out_array)
 
    bmp_out.Palette = bmp_in.Palette
    bmp_out.SetResolution _
        (bmp_in.HorizontalResolution, bmp_in.VerticalResolution)
 
    ' Bildausschnitt übertragen
    With cutrectangle
       Dim outline As Integer = -1
       For y = .Top To .Top + .Height - 1
           Dim sy As Integer = y * bmp_in_data.Stride
           outline += 1
           Byte_Out_Index = outline * bmp_out_data.Stride - 1
           For x = .Left To .Left + .Width - 1
               Byte_In_Index = sy + x
               Byte_Out_Index += 1
               bmp_out_array(Byte_Out_Index) = bmp_in_array(Byte_In_Index)
           Next x
       Next y
    End With
 
    ' Die modifizierten Arraydaten  in die Ausgabe-Bitmap kopieren
    Runtime.InteropServices.Marshal.Copy _
            (bmp_out_array, 0, bmp_out_ptr, bmp_out_array.Length)
 
    ' Die gesperrten Bilddaten im Speicher wieder freigeben
    bmp_in.UnlockBits(bmp_in_data)
    bmp_out.UnlockBits(bmp_out_data)
 
    'TIFF speichern
    Dim EncoderParameters As New Drawing.Imaging.EncoderParameters(1)
    EncoderParameters.Param(0) =  _
              New Drawing.Imaging.EncoderParameter( _
              Drawing.Imaging.Encoder.Compression, _
              Fix(Drawing.Imaging.EncoderValue.CompressionNone))
 
    bmp_out.Save(Bilddatei_out, EncoderInfo("TIFF"), EncoderParameters)
    bmp_in.Dispose() : bmp_out.Dispose()
 
End Sub