troubleshooting Question

Image splicing

Avatar of dizzy01
dizzy01Flag for United Kingdom of Great Britain and Northern Ireland asked on
Programming.NET ProgrammingVisual Basic.NET
5 Comments1 Solution464 ViewsLast Modified:

I have written an application that takes two .tif images and splices the first on top of the second.  It also reduces the spliced image's bit depth to 1.  This application works but is REALLY slow :) and i was hoping for some help to improve it's performance.  Any tips and/or code examples would be appreciated.


Imports System
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Public Class Form1
    Private Sub btnGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGo.Click
        Dim tif1 As String = "c:\imgtest\004.tif"
        Dim tif2 As String = "c:\imgtest\005.tif"
        Dim tif3 As String = "c:\imgtest\006.tif"
        Dim img1 As Image = Image.FromFile(tif1)
        Dim img2 As Image = (Image.FromFile(tif2))
        Dim Width As Integer = (img1.Width)
        Dim Height As Integer = (img1.Height + img2.Height)
        Dim img3 As Bitmap = (New Bitmap(Width, Height))
        img3.SetResolution(200, 200)
        Dim g As Graphics = (Graphics.FromImage(img3))
        g.DrawImage(img1, New Point(0, 0))
        g.DrawImage(img2, New Point(0, img2.Height))
        'new code from James
        'lock the bits of the original bitmap
        Dim bmdo As BitmapData = img3.LockBits(New Rectangle(0, 0, img3.Width, img3.Height), ImageLockMode.ReadOnly, img3.PixelFormat)
        'add new 1bpp bitmap and lock its bits
        Dim img4 As Bitmap = New Bitmap(img3.Width, img3.Height, PixelFormat.Format1bppIndexed)
        img4.SetResolution(200, 200)
        Dim bmdn As BitmapData = img4.LockBits(New Rectangle(0, 0, img4.Width, img4.Height), ImageLockMode.ReadWrite, PixelFormat.Format1bppIndexed)
        'scan through the pixels y by x
        Dim y As Integer
        For y = 0 To img3.Height - 1
            Dim x As Integer
            For x = 0 To img3.Width - 1
                'generate address of colour pixel
                Dim index As Integer = y * bmdo.Stride + x * 4
                'check it's brightness
                If Color.FromArgb(Marshal.ReadByte(bmdo.Scan0, index + 2), Marshal.ReadByte(bmdo.Scan0, index + 1), Marshal.ReadByte(bmdo.Scan0, index)).GetBrightness() > 0.5F Then
                    Me.SetIndexedPixel(x, y, bmdn, True)
                End If
        'tidy up
        Dim info As ImageCodecInfo = Nothing
        Dim ice As ImageCodecInfo
        For Each ice In ImageCodecInfo.GetImageEncoders()
            If ice.MimeType = "image/tiff" Then
                info = ice
                Exit For
            End If
        Dim enc As Encoder = Encoder.SaveFlag
        Dim ep As New EncoderParameters(1)
        ep.Param(0) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionCCITT4))
        img4.Save(tif3, info, ep)
        'end of new code
    End Sub
    Protected Sub SetIndexedPixel(ByVal x As Integer, ByVal y As Integer, ByVal bmd As BitmapData, ByVal pixel As Boolean)
        Dim index As Integer = y * bmd.Stride + (x >> 3)
        Dim p As Byte = Marshal.ReadByte(bmd.Scan0, index)
        Dim mask As Byte = &H80 >> (x And &H7)
        If pixel Then
            p = p Or mask
            p = p And CByte(mask ^ &HFF)
        End If
        Marshal.WriteByte(bmd.Scan0, index, p)
    End Sub

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 5 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 5 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros