请教，如何用程序保存picturebox里的图片为单色位图，我用savepicture 保存的黑白位图为

freethink168

如题：请教大家帮忙用程序把picbox里的图片保存为单色位图。

程序种用如下代码保存的为24色位图，SavePicture Picture2.Image, "D:\test.bmp"
有没有什么好方法可以直接保存为单色位图。程序是用vb写的。

freethink168

现在想法是读取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| 所有文件 *.* |*.**|"

freethink168

只是感觉这个方法有点笨了，不知道坛子里的高手们有没有其它的好的方法给推荐下。先谢谢各位了。