[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 250
  • Last Modified:

How to Open and then Save Tiff Image using same or better resolution?

I have code that opens Tiff files and then saves each frame in the Tiff files locally. The problem is that the quality is destroyed, so you when you zoom in on the images it looks really bad.  How can I fix this?  There has to be a way to get the resolution from the original image and save in that format, right?

Thanks,  Here is my code...(need fixed ASAP, so price is high)

'Sets the tiff file as an image object.
        objImage = objImage.FromFile(strFilePath, True)
        Dim objGuid As Guid = (objImage.FrameDimensionsList(0))
        Dim objDimension As System.Drawing.Imaging.FrameDimension = New System.Drawing.Imaging.FrameDimension(objGuid)

        'Gets the total number of frames in the .tiff file
        totFrame = objImage.GetFrameCount(objDimension)

        'Adds number of frames to the combo box for displaying purposes.
        Dim i As Integer
        For i = 0 To totFrame - 1

        'Sets the temporary folder to "C:\temp\"
        strPath = "c:\temp\" & _instance

        'Saves every frame as a seperate file.
        Dim z As Integer
        z = 0
        curF = 0
        For z = 0 To (totFrame - 1)
            objImage.SelectActiveFrame(objDimension, curF)
            objImage.Save(strPath & curF & ".tif", Drawing.Imaging.ImageFormat.Tiff)
            curF = curF + 1

        curF = 0

        'set window caption
        Me.Text = ImageCaption

        'Displayes the frames
        Me.Cursor = System.Windows.Forms.Cursors.Default
1 Solution
This function may help in the quality....

    Private Function FixedSize(ByVal imgPhoto As Image, ByVal Width As Integer, ByVal Height As Integer) As Image
        Dim sourceWidth As Integer = imgPhoto.Width
        Dim sourceHeight As Integer = imgPhoto.Height
        Dim sourceX As Integer = 0
        Dim sourceY As Integer = 0
        Dim destX As Integer = 0
        Dim destY As Integer = 0

        Dim nPercent As Single = 0
        Dim nPercentW As Single = 0
        Dim nPercentH As Single = 0

        nPercentW = (CType(Width / CType(sourceWidth, Double), Double))
        nPercentH = (CType(Height / CType(sourceHeight, Double), Double))
        If nPercentH < nPercentW Then
            nPercent = nPercentH
            destX = System.Convert.ToInt16((Width - (sourceWidth * nPercent)) / 2)
            nPercent = nPercentW
            destY = System.Convert.ToInt16((Height - (sourceHeight * nPercent)) / 2)
        End If

        Dim destWidth As Integer = CType((sourceWidth * nPercent), Integer)
        Dim destHeight As Integer = CType((sourceHeight * nPercent), Integer)
        Dim bmPhoto As Bitmap
        bmPhoto = New Bitmap(Width, Height, PixelFormat.Format24bppRgb)
        bmPhoto.SetResolution(imgPhoto.HorizontalResolution, imgPhoto.VerticalResolution)

        Dim grPhoto As Graphics = Graphics.FromImage(bmPhoto)
        grPhoto.InterpolationMode = InterpolationMode.NearestNeighbor

        grPhoto.DrawImage(imgPhoto, New Rectangle(destX, destY, destWidth, destHeight), New Rectangle(sourceX, sourceY, sourceWidth, sourceHeight), GraphicsUnit.Pixel)

        Return bmPhoto
    End Function


Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now