请教，如何用程序保存picturebox里的图片为单色位图，我用savepicture 保存的黑白位图为
如题：请教大家帮忙用程序把picbox里的图片保存为单色位图。程序种用如下代码保存的为24色位图，SavePicture Picture2.Image, "D:\test.bmp"
有没有什么好方法可以直接保存为单色位图。程序是用vb写的。 现在想法是读取pic各个像素的值，然后根据位图的格式用程序在硬盘上写出来一个单色位图。并参考了网上读取位图的例子。但是本人对图像方面概念有点模糊，对于单色的位图如何保存，希望高手们给个方法。
代码如下：
Private Sub Command1_Click()
' SendKeys "%{Tab}"
On Error GoTo err1
Dim pName As String, laterName As String, nameLong As Long
dlg1.Action = 1
pName = dlg1.FileName
Open pName For Binary As #1
Command2.Enabled = False
Dim bmpStyle1 As Byte'。。。。。。判断是不是BMP图片
Dim bmpStyle2 As Byte
Get #1, 1, bmpStyle1
Get #1, 2, bmpStyle2
If bmpStyle1 = 66 And bmpStyle2 = 77 Then '大写字母BM
MsgBox laterName & "文件是" & "BMP图片"
Else
MsgBox "格式错误"
Close #1
Exit Sub
End If
If getColor() = 24 Then '从1ch开始的一个字节存储位数的 调用子函数实现
MsgBox laterName & "文件是" & getColor() & "位图"
Else
MsgBox laterName & "文件是" & getColor() & "位格式暂时不支持,请打开24位格式的BMP"
Close #1
Exit Sub
End If
Dim maxX As Long
Dim maxY As Long
Get #1, 18 + 1, maxX '宽 需要加 1位图的常在12h开始的四个字节里存储，宽在16h开始的四个字节里面存储
Get #1, 22 + 1, maxY '高
picShow.Cls
Dim pos As Long'文件钟点的位置 。。。。。。开始描点
Dim Cha As Integer '行末尾填充的字节数
Dim ix2 As Integer '用于描点的坐标
Dim iy2 As Integer '用于描点的坐标
Dim sRed As Byte '存红色的值
Dim sGreen As Byte '存绿色的值
Dim sBlue As Byte'存蓝色的值
Dim firstPos As Byte'第一个像素存放的位置
Cha = (4 - (maxX * 3) Mod 4) Mod 4 '行末尾填充的字节因为图像的一行内的字节数必须被四整除的这个用来求行多余的空字节
'ix2 = 0 '用于描x坐标 从0开始到maxX-1
'iy2 = maxY - 1'用于描y坐标 从0开始到maxY-1
Get #1, 10 + 1, firstPos '得到像素颜色的开始的位置 firstspos，从文件开始到位图数据开始之间的数据(bitmap data)之间的偏移量
pos = firstPos + (maxX * 3 + Cha) * maxY '求最后一点像素的位置
For iy2 = 0 To maxY - 1
For ix2 = maxX - 1 To 0 Step -1
Get #1, pos, sRed
Get #1, pos - 1, sGreen '从文件中读取颜色
Get #1, pos - 2, sBlue
picShow.PSet (ix2, iy2), RGB(sRed, sGreen, sBlue) '画出该位置的像素点
pos = pos - 3
Next ix2
pos = pos - Cha '描到了行末尾，则跳过不要的字节
Next iy2
Close #1
Command2.Enabled = True
Exit Sub
err1:
If Err = 32755 Then Exit Sub '有commondialog引起的错误
MsgBox "发生错误"
Close #1
End Sub
Private Function getColor() As Integer
Dim picBit As Byte '取得图片的位数
Get #1, 28 + 1, picBit
getColor = picBit
End Function
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Show
picShow.AutoRedraw = False
picShow.ScaleMode = vbPixels
dlg1.Filter = "文件bmp *.bmp |*.bmp| 所有文件 *.* |*.**|" 只是感觉这个方法有点笨了，不知道坛子里的高手们有没有其它的好的方法给推荐下。先谢谢各位了。
页:
[1]