none
Error on saving a Format16bppGrayScale image in VB.net 2017 RRS feed

  • Question

  • HI,

    I'm struggling with writing a 16bppscaleformat. I try to create an image of 10 * 10, with PixelFormat.Format16bppGrayScale. It works, until I try to save it. Then I get the following error:

    'lBitMap.Save("c:\temp\test16bppGrayScale" + ".tif", ImageFormat.Tiff)' threw an exception of type 'System.Runtime.InteropServices.ExternalException'

    My routine is as follows:

    Sub createTiff()

            Dim lBitMap As Bitmap
            Dim lRect As Rectangle
            Dim lBMPData As BitmapData
            Dim lIntPtr As IntPtr

            lBitMap = New Bitmap(10, 10, Imaging.PixelFormat.Format16bppGrayScale)
            lRect = New Rectangle(0, 0, lBitMap.Width, lBitMap.Height)


            lBMPData = lBitMap.LockBits(lRect, System.Drawing.Imaging.ImageLockMode.ReadWrite, lBitMap.PixelFormat)

            Dim lOffset As Int32
            Dim lShort As Short = 100       
            Dim X As Integer
            Dim Y As Integer

            For X = 0 To lBitMap.Width - 1
                For Y = 0 To lBitMap.Height - 1

                    lOffset = (Y * lBitMap.Width + X) * 2

                    If lOffset < lBMPData.Stride() * lBitMap.Width Then
                        Marshal.WriteInt16(lBMPData.Scan0 + lOffset, lShort)
                    End If
                Next Y
            Next X

            lBitMap.UnlockBits(lBMPData)

            lBitMap.Save("c:\temp\test16bppGrayScale" + ".tif", ImageFormat.Tiff)

        End Sub

    I use VS2017.

    Any help will be appreciated!

    Kind regards,

    Ariene

    Wednesday, January 17, 2018 11:20 AM

All replies

  • You can do something like this, with Imaging.BitmapSource

    =>

    Dim bitmap As Bitmap = New Bitmap(10, 10, System.Drawing.Imaging.PixelFormat.Format16bppGrayScale)
    Dim bitmapData As BitmapData = bitmap.LockBits(New Rectangle(0, 0, bitmap.Width, bitmap.Height), ImageLockMode.ReadWrite, bitmap.PixelFormat)
    Dim lOffset As Integer
    Dim lShort As Short = 100
    Dim X As Integer
    Dim Y As Integer
    For X = 0 To bitmap.Width - 1
        For Y = 0 To bitmap.Height - 1
            lOffset = (Y * bitmap.Width + X) * 2
            If lOffset < bitmapData.Stride() * bitmap.Width Then
                Marshal.WriteInt16(bitmapData.Scan0 + lOffset, lShort)
            End If
        Next Y
    Next X
    Dim bipmatsource As Imaging.BitmapSource = Imaging.BitmapSource.Create(bitmap.Width, bitmap.Height, bitmap.HorizontalResolution, bitmap.VerticalResolution, PixelFormats.Gray16, Nothing, bitmapData.Scan0, (bitmapData.Stride * bitmap.Height), bitmapData.Stride)
    bitmap.UnlockBits(bitmapData)
    
    Dim outStream As FileStream = New FileStream("c:\temp\Test16bppGrayScale.tif", FileMode.Create)
    Dim enc As Imaging.TiffBitmapEncoder = New Imaging.TiffBitmapEncoder
    enc.Frames.Add(Imaging.BitmapFrame.Create(bipmatsource))
    enc.Save(outStream)
    outStream.Close()
    

    • Proposed as answer by Ashidacchi Saturday, January 20, 2018 4:49 AM
    Wednesday, January 17, 2018 12:45 PM
  • Thank you very much.

    It works now, but not before I added assemblies PresentationCore and WindowBase as project references.

    Thank you again,

    Ariene

    Wednesday, January 17, 2018 4:32 PM