VB代码VB小程序：将彩色图像转变为黑白图像

VB代码VB小程序：将彩色图像转变为黑白图像

本程序使用两种方法将一幅彩色图像转变为黑白图像：用 API 方法、用 VB 控件方法。通过比较两种方法不难发现：

用 VB 控件进行转换，过程直观，代码好理解，对学习和理解 VB 绘图语句很有帮助，但速度慢。

用 API 方法进行转换，需操作二进制数组，像素点的行列定位较复杂，但转换速度快，几乎是瞬间就完成了转换。

' '以下是窗体代码，在 VB6 调试通过

'需在窗体放置 5 个控件：Command1、Command2、Command3、Picture1、Text1

'本人原创，转载请注明文章来源：

/100bd/blog/item/1f4653397c5d693296ddd800.html

Dim ctExit As Boolean

Private Type BitMap

bmType As Long '图像类型：0 表示是位图

bmWidth As Long '图像宽度（像素）

bmHeight As Long '图像高度（像素）

bmWidthBytes As Long '每一行图像的字节数

bmPlanes As Integer '图像的图层数

bmBitsPixel As Integer '图像的位数

bmBits As Long '位图的内存指针

End Type

Private Declare Function GetObject Lib "gdi32" Alias

"GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Sub Form_Load()

Me.Caption = "转变为黑白图片"

Text1.Text = App.Path & "\Tu1.jpg"

Command1.Caption = "打开": Command1.ToolTipText = "打开指定的图片文件"

Command2.Caption = "转换1": Command2.ToolTipText = "用 API 方法转变为黑白图片"

Command3.Caption = "转换2": Command3.ToolTipText = "用 VB 控件方法转换为黑白图像"

Picture1.AutoSize = True: Picture1.AutoRedraw = True

Picture1.ScaleMode = 3

Picture1.ToolTipText = "如果已转换为黑白图像，双击恢复为原来的图像"

'设置控件位置，实际可以在设计窗体时完成

Dim W1 As Long

W1 = Me.TextWidth("A")

Command2.Move W1, W1, W1 * 6, W1 * 3

Command3.Move W1 * 8, W1, W1 * 7, W1 * 3

Command1.Move W1 * 15, W1, W1 * 7, W1 * 3

Text1.Move W1 * 22, W1, W1 * 80, W1 * 3

Picture1.Move W1, W1 * 5, W1 * 40, W1 * 40

Call RndImg(Picture1) '随机画一些图像

End Sub

Private Sub RndImg(Kj As Object)

'随机画一些图像

Dim I As Long

Randomize

Kj.DrawWidth = 3

For I = 1 To 100

Kj.Line (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd)-Step(50, 50), &HFFFFFF * Rnd, BF

Kj.Circle (Kj.ScaleWidth * Rnd, Kj.ScaleHeight * Rnd), 30 * Rnd, &HFFFFFF * Rnd

Next

Kj.DrawWidth = 1

Kj.Font.Size = 24: Kj.Font.Bold = True

Kj.CurrentX = 10: Kj.CurrentY = 10: Kj.ForeColor = &H777777

Kj.Print Me.Caption

Kj.CurrentX = 11: Kj.CurrentY = 11: Kj.ForeColor = RGB(0, 0, 210)

Kj.Print Me.Caption

Kj.Picture = Kj.Image

End Sub

Private Sub Form_Unload(Cancel As Integer)

ctExit = True '防止绘图未完成前用户关闭窗口时无法正常终止程序

End Sub

Private Sub Command1_Click()

'打开图片文件

Dim F As String

On Error GoTo Err1

F = Trim(Text1.Text)

Picture1.Picture = LoadPicture(F)

Exit Sub

Err1:

MsgBox "无法读取文件：" & vbCrLf & F, vbInformation

End Sub

Private Sub Command2_Click()

'用 API 方法转变为黑白图片

Dim BMPs() As Byte, Bs As Long, Ps As Long, MapInf As BitMap

Dim R As Long, G As Long, B As Long, S As Long, I As Long

GetObject Picture1.Image, Len(MapInf), MapInf '用 MapInf 得到 Picture1 的图像信息

Ps = MapInf.bmWidthBytes \ MapInf.bmWidth '每像素字节数=行字节数\宽度

Bs = MapInf.bmWidth * MapInf.bmHeight * Ps '总字节数=宽度*高度*每个像素字节

ReDim BMPs(0 To Bs - 1)

GetBitmapBits Picture1.Image, Bs, BMPs(0) '将 Picture1 的图像颜色值读入二进数组 BMPs()