VB.NET单黑白位图转换程序CPU占用低、处理慢的优化咨询

DevOps 小满

2026-8-4

优化VB.NET 1位位图转换速度的方案

先聊聊你的问题：虽然已经用了LockBits避开GDI+的低效操作，但CPU占用率极低，说明程序完全没利用好硬件资源，再加上代码里有不少拖慢速度的细节，才导致单张处理超1分钟。下面从核心瓶颈入手，给你一套优化方案，目标能达到几秒一张的处理效率，同时适配批量处理需求：

一、先揪出核心性能痛点

你的代码里有几个明显的低效点：

单线程绑定UI：所有计算都在UI线程跑，一次只处理一张，多核CPU完全闲置，这是CPU占用低的核心原因
循环内的异常捕获：在像素循环里加Try-Catch，这会极大拖慢执行效率（异常捕获本身是高开销操作，而且这里几乎不会抛出异常）
浮点运算冗余：灰度计算、错误扩散里用了大量Double和除法，不如整数运算高效
数组使用不合理：二维data(x,y)数组访问速度慢，输出的line数组每次循环都重新创建，增加内存分配开销
UI线程阻塞：直接在UI线程处理图片，不仅速度慢，还会导致界面卡死

二、具体优化措施

1. 并行化+后台线程处理

既然CPU负载很低，直接用Parallel类或者Task.Run把处理逻辑放到后台线程，批量处理时并行处理多张图片，把多核CPU的性能拉满。同时把图片处理和UI操作分离，避免界面卡死。

2. 移除循环内的`Try-Catch`

你代码里的Try-Catch块完全没必要，直接删掉，能大幅提升循环执行速度。

3. 用整数运算替代浮点运算

把灰度计算和错误扩散的浮点逻辑改成整数操作，避免类型转换和浮点计算的开销：

灰度计算：把(r*0.299 + g*0.587 + b*0.114)/255改成整数版(r*299 + g*587 + b*114) \ 1000（放大10倍避免精度损失）
错误扩散：用整数移位替代除法（比如7/16等价于(error *7) >>4），同时用整数数组存储错误值，避免SByte的溢出问题

4. 优化数组访问

把二维data数组改成一维数组，内存连续，CPU缓存命中率更高，访问速度更快
复用输出的字节数组，不用每次循环都创建新数组

5. 提前转成灰度图

先把输入的24位RGB图转成8位灰度图，减少后续每个像素的计算量，不用反复计算RGB转灰度的逻辑

三、优化后的代码示例

下面是修改后的核心转换函数，以及适配批量处理的完整代码：

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports System.Threading.Tasks
Imports System.IO

Public Class Form1

    ' 优化后的1位位图转换函数
    Public Shared Function ConvertTo1BitOptimized(ByVal input As Bitmap) As Bitmap
        Dim masks = New Byte() {&H80, &H40, &H20, &H10, &H8, &H4, &H2, &H1}
        Dim width = input.Width
        Dim height = input.Height
        Dim output = New Bitmap(width, height, PixelFormat.Format1bppIndexed)

        ' 先转成8位灰度图，减少后续计算量
        Using grayInput = ConvertTo8BitGray(input)
            Dim grayData = grayInput.LockBits(New Rectangle(0, 0, width, height), ImageLockMode.ReadOnly, PixelFormat.Format8bppIndexed)
            Dim grayBuffer = New Byte(grayData.Stride * height - 1) {}
            Marshal.Copy(grayData.Scan0, grayBuffer, 0, grayBuffer.Length)
            grayInput.UnlockBits(grayData)

            ' 用一维数组存储错误扩散数据，提升访问速度
            Dim errorBuffer = New Integer(width * height - 1) {}
            Dim outputData = output.LockBits(New Rectangle(0, 0, width, height), ImageLockMode.WriteOnly, PixelFormat.Format1bppIndexed)
            Dim outputBuffer = New Byte(outputData.Stride * height - 1) {}

            ' 处理每一行像素
            For y = 0 To height - 1
                Dim grayLineStart = y * grayData.Stride
                Dim errorLineStart = y * width
                Dim outputLineStart = y * outputData.Stride
                Array.Clear(outputBuffer, outputLineStart, outputData.Stride)

                For x = 0 To width - 1
                    ' 计算带错误扩散的灰度值
                    Dim currentGray = grayBuffer(grayLineStart + x) + errorBuffer(errorLineStart + x)
                    Dim isWhite = currentGray > 128
                    Dim pixelError = If(isWhite, currentGray - 255, currentGray)

                    ' 应用Floyd-Steinberg错误扩散（整数移位替代除法）
                    If x < width - 1 Then
                        errorBuffer(errorLineStart + x + 1) += pixelError * 7 >> 4
                    End If
                    If y < height - 1 Then
                        Dim nextLineStart = (y + 1) * width
                        If x > 0 Then
                            errorBuffer(nextLineStart + x - 1) += pixelError * 3 >> 4
                        End If
                        errorBuffer(nextLineStart + x) += pixelError * 5 >> 4
                        If x < width - 1 Then
                            errorBuffer(nextLineStart + x + 1) += pixelError * 1 >> 4
                        End If
                    End If

                    ' 设置输出像素的位
                    If isWhite Then
                        Dim byteIndex = x \ 8
                        Dim bitIndex = x Mod 8
                        outputBuffer(outputLineStart + byteIndex) = outputBuffer(outputLineStart + byteIndex) Or masks(bitIndex)
                    End If
                Next
            Next

            ' 写入输出位图
            Marshal.Copy(outputBuffer, 0, outputData.Scan0, outputBuffer.Length)
            output.UnlockBits(outputData)
        End Using

        Return output
    End Function

    ' 辅助函数：将24位RGB图转成8位灰度图
    Private Shared Function ConvertTo8BitGray(input As Bitmap) As Bitmap
        Dim grayBitmap = New Bitmap(input.Width, input.Height, PixelFormat.Format8bppIndexed)
        ' 设置灰度调色板
        Dim palette = grayBitmap.Palette
        For i = 0 To 255
            palette.Entries(i) = Color.FromArgb(i, i, i)
        Next
        grayBitmap.Palette = palette

        Dim inputData = input.LockBits(New Rectangle(0, 0, input.Width, input.Height), ImageLockMode.ReadOnly, PixelFormat.Format24bppRgb)
        Dim outputData = grayBitmap.LockBits(New Rectangle(0, 0, grayBitmap.Width, grayBitmap.Height), ImageLockMode.WriteOnly, PixelFormat.Format8bppIndexed)

        Dim inputBuffer = New Byte(inputData.Stride * inputData.Height - 1) {}
        Dim outputBuffer = New Byte(outputData.Stride * outputData.Height - 1) {}

        Marshal.Copy(inputData.Scan0, inputBuffer, 0, inputBuffer.Length)

        ' 逐像素计算灰度值
        For y = 0 To input.Height - 1
            Dim inputStart = y * inputData.Stride
            Dim outputStart = y * outputData.Stride
            For x = 0 To input.Width - 1
                Dim r = inputBuffer(inputStart + x * 3)
                Dim g = inputBuffer(inputStart + x * 3 + 1)
                Dim b = inputBuffer(inputStart + x * 3 + 2)
                ' 整数版灰度计算，避免浮点开销
                Dim gray = (r * 299 + g * 587 + b * 114) \ 1000
                outputBuffer(outputStart + x) = CByte(gray)
            Next
        Next

        Marshal.Copy(outputBuffer, 0, outputData.Scan0, outputBuffer.Length)
        input.UnlockBits(inputData)
        grayBitmap.UnlockBits(outputData)

        Return grayBitmap
    End Function

    ' 批量处理按钮逻辑（并行处理多张图片）
    Private Async Sub btBatchProcess_Click(sender As Object, e As EventArgs) Handles btBatchProcess.Click
        If String.IsNullOrEmpty(tbInPic.Text) OrElse String.IsNullOrEmpty(tbOutPic.Text) Then
            MessageBox.Show("请先选择输入和输出文件夹")
            Return
        End If

        ' 获取所有图片路径
        Dim imageExtensions = {".jpg", ".png", ".gif"}
        Dim imagePaths = Directory.GetFiles(tbInPic.Text) _
                                  .Where(Function(p) imageExtensions.Contains(Path.GetExtension(p).ToLower())) _
                                  .ToArray()

        If imagePaths.Length = 0 Then
            MessageBox.Show("输入文件夹中未找到图片")
            Return
        End If

        ' 并行处理图片，充分利用多核CPU
        Await Task.Run(Sub()
                           Parallel.ForEach(imagePaths, Sub(path)
                                                           Try
                                                               Using inputBmp = New Bitmap(path)
                                                                   ' 可选：添加图片缩放（你提到的优化点）
                                                                   Using scaledBmp = New Bitmap(inputBmp, New Size(inputBmp.Width \ 2, inputBmp.Height \ 2))
                                                                       Using outputBmp = ConvertTo1BitOptimized(scaledBmp)
                                                                           Dim outputFileName = Path.GetFileNameWithoutExtension(path) + "_1bit.bmp"
                                                                           Dim outputPath = Path.Combine(tbOutPic.Text, outputFileName)
                                                                           outputBmp.Save(outputPath, ImageFormat.Bmp)
                                                                       End Using
                                                                   End Using
                                                               End Using
                                                           Catch ex As Exception
                                                               Debug.WriteLine($"处理图片 {path} 出错：{ex.Message}")
                                                           End Try
                                                       End Sub)
                       End Sub)

        MessageBox.Show("批量处理完成！")
    End Sub

    ' 输入文件夹浏览
    Private Sub btBrowesIn_Click(sender As Object, e As EventArgs) Handles btBrowesIn.Click
        If FolderBrowserDialog1.ShowDialog() = DialogResult.OK Then
            tbInPic.Text = FolderBrowserDialog1.SelectedPath
        End If
    End Sub

    ' 输出文件夹浏览（修正原代码的赋值错误）
    Private Sub btBrowesOut_Click(sender As Object, e As EventArgs) Handles btBrowesOut.Click
        If FolderBrowserDialog2.ShowDialog() = DialogResult.OK Then
            tbOutPic.Text = FolderBrowserDialog2.SelectedPath
        End If
    End Sub

    ' 单张预览按钮（后台线程处理，避免UI阻塞）
    Private Async Sub btGo_Click(sender As Object, e As EventArgs) Handles btGo.Click
        Dim opf As New OpenFileDialog()
        opf.Filter = "Choose Image(*.jpg;*.png;*.gif)|*.jpg;*.png;*.gif"
        If opf.ShowDialog() = DialogResult.OK Then
            ' 更新原图预览
            PictureBox1.Image?.Dispose()
            PictureBox1.Image = Image.FromFile(opf.FileName)

            ' 后台线程处理转换，避免UI卡死
            Await Task.Run(Sub()
                               Using inputBmp = New Bitmap(opf.FileName)
                                   Using outputBmp = ConvertTo1BitOptimized(inputBmp)
                                       ' 回到UI线程更新预览
                                       Invoke(Sub()
                                                  PictureBox2.Image?.Dispose()
                                                  PictureBox2.Image = New Bitmap(outputBmp)
                                              End Sub)
                                   End Using
                               End Using
                           End Sub)
        End If
    End Sub

End Class

四、额外优化建议

缩放策略：你提到的图片缩放是非常有效的优化手段，缩小图片后像素数线性减少，处理时间也会大幅降低，建议根据实际需求设置合适的缩放比例
内存管理：所有Bitmap对象都用Using语句包裹，确保及时释放内存，避免批量处理时内存溢出
简化算法：如果不需要错误扩散（抖动）效果，可以直接用固定阈值转换，速度会更快（但图片的层次感会稍弱）
第三方库替代：如果允许引入外部库，可以考虑使用ImageSharp或Magick.NET这类高性能图像库，它们的底层优化比手动写LockBits更完善

内容的提问来源于stack exchange，提问作者David

VB.NET单黑白位图转换程序CPU占用低、处理慢的优化咨询

一、先揪出核心性能痛点 #

二、具体优化措施 #

1. 并行化+后台线程处理 #

2. 移除循环内的Try-Catch #

3. 用整数运算替代浮点运算 #

4. 优化数组访问 #

5. 提前转成灰度图 #

三、优化后的代码示例 #

四、额外优化建议 #