如何把图片转化为单色存储

Question

开始->程序->附件->画图

Answer 1

SetBitmapBits VB声明 
Declare Function SetBitmapBits Lib "gdi32" Alias "SetBitmapBits" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long 
说明 
将来自缓冲区的二进制位复制到一幅位图 
返回值 
Long，执行成功则返回字节数量，零表示失败 
参数表 
参数 类型及说明 
hBitmap Long，位图的句柄 
dwCount Long，欲复制的字节数量 
lpBits Any，指向一个缓冲区的指针。这个缓冲区包含了为位图正确格式化的位图位 
注解 
在Win32中，应使用与设备无关位图
 Top
 

Answer 2

lihonggen0(用VB):
可以给个完整例子吗

Answer 3

用程序有一个偷懒的办法，就是找一些早期DOS下的图象转换软件，这些软件都支持参数，用这个软件放到你程序的目录中，用的时候调用就可以了！我在几年前用过这种软件！但是实在是时间长了，所以记不得名字了！反正就是一个思路，希望可以给你一些启发！
软件下载网址：华军主页： www.newhua.com
那里有些老的软件还是可以找到的。

Answer 4

是黑白两色吧.
用picturebox的paintpicture把图可以转换成黑白两色,然后用savepicture就可以了.

Answer 5

http://www.csdn.net/Expert/topic/475/475857.shtm
对你应该有帮助 
我好像记的单色的转换有个api，我帮你找找

Answer 6

CopyImage VB声明 
Declare Function CopyImage Lib "user32" Alias "CopyImage" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 
说明 
复制位图、图标或指针，同时在复制过程中进行一些转换工作 
返回值 
Long，执行成功则返回新图象的句柄，零表示失败。会设置GetLastError 
参数表 
参数 类型及说明 
handle Long，欲复制的图象的句柄 
un1 Long，下述常数之一：MAGE_BITMAP， IMAGE_CURSOR 或 IMAGE_ICON 
n1 Long，副本以像素表示的宽度 
n2 Long，副本以像素表示的高度 
un2 Long，下述常数任意组合： 
LR_DELETEORG 删除原来的图象 
LR_COPYRETURNORG 忽略n1和n2设置 
LR_MONOCHROME 创建一个单色副本 
LR_COPYFROMRESOURCE 在原始资源的基础上创建一个副本，原始图象即是从那个资源中载入的。假设我们想为一个32×32的图标制作一个64×64的副本。如果不设这个标志，CopyImage会直接放大原来的图标。而使用这个标志后，CopyImage首先检查资源文件中是否存在这个图标的一个64×64版本，如果存在，就直接载入品质更好的图象 
注解 
这个函数通常在希望复制已选入其他设备场景的一幅位图时使用——例如，复制已成为ImageList控件一部分的某幅位图。选定的位图将不能使用，因为一次只能将位图选入一个设备场景
 
 

Answer 7

TechnoFantasy(www.applevb.com)　的代码：http://www.applevb.com/sourcecode/gray.zip   

Answer 8

给lihonggen0(用VB)　加分吧
TechnoFantasy(www.applevb.com)　的代码：http://www.applevb.com/sourcecode/gray.Option ExplicitPrivate Declare Function GetPixel Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, _
      ByVal Y As Long, ByVal crColor As Long) As Long
Private tmpPic As PicturePrivate Sub Form_Load()
    Picture1.ScaleMode = 3
    Picture1.AutoRedraw = True
    Set tmpPic = Picture1.Picture
End SubPrivate Sub Command1_click()
    Dim width5  As Long, heigh5 As Long, rgb5 As Long
    Dim hdc5 As Long, i As Long, j As Long
    Dim bBlue As Long, bRed As Long, bGreen As Long
    Dim Y As Long
    
    width5 = Picture1.ScaleWidth
    heigh5 = Picture1.ScaleHeight
    hdc5 = Picture1.hdc
    For i = 1 To width5
        For j = 1 To heigh5
            rgb5 = GetPixel(hdc5, i, j)
            bBlue = Blue(rgb5)      '获得兰色值
            bRed = Red(rgb5)        '获得红色值
            bGreen = Green(rgb5)    '获得绿色值
            '将三原色转换为灰度
            Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
            '将灰度转换为RGB
            rgb5 = RGB(Y, Y, Y)
            SetPixelV hdc5, i, j, rgb5
        Next j
    Next i
    Set Picture1.Picture = Picture1.Image
End SubPrivate Function Red(ByVal mlColor As Long) As Long
    '从RGB值中获得红色值
    Red = mlColor And &HFF
End Function
Private Function Green(ByVal mlColor As Long) As Long
    '从RGB值中获得绿色值
    Green = (mlColor \ &H100) And &HFF
End Function
Private Function Blue(ByVal mlColor As Long) As Long
    ''从RGB值中获得蓝色值
    Blue = (mlColor \ &H10000) And &HFF
End Function

Answer 9

保存的大小还是一样的
Option ExplicitPrivate Declare Function GetPixel Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" _
     (ByVal hdc As Long, ByVal x As Long, _
      ByVal Y As Long, ByVal crColor As Long) As Long
Private tmpPic As PicturePrivate Sub Command2_Click()
SavePicture Picture1.Image, "C:\cc.bmp"
End SubPrivate Sub Command3_Click()
SavePicture Picture1.Image, "C:\hh.bmp"End SubPrivate Sub Form_Load()
    Picture1.ScaleMode = 3
    Picture1.AutoRedraw = True
    Set tmpPic = Picture1.Picture
End SubPrivate Sub Command1_click()
    Dim width5  As Long, heigh5 As Long, rgb5 As Long
    Dim hdc5 As Long, i As Long, j As Long
    Dim bBlue As Long, bRed As Long, bGreen As Long
    Dim Y As Long
    
    width5 = Picture1.ScaleWidth
    heigh5 = Picture1.ScaleHeight
    hdc5 = Picture1.hdc
    For i = 1 To width5
        For j = 1 To heigh5
            rgb5 = GetPixel(hdc5, i, j)
            bBlue = Blue(rgb5)      '获得兰色值
            bRed = Red(rgb5)        '获得红色值
            bGreen = Green(rgb5)    '获得绿色值
            '将三原色转换为灰度
            Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
            If Y > 255 \ 2 Then '只有黑白2色
                Y = 255
            Else
                Y = 0
            End If
            '将灰度转换为RGB
            rgb5 = RGB(Y, Y, Y)
            SetPixelV hdc5, i, j, rgb5
        Next j
    Next i
    Set Picture1.Picture = Picture1.Image
End SubPrivate Function Red(ByVal mlColor As Long) As Long
    '从RGB值中获得红色值
    Red = mlColor And &HFF
End Function
Private Function Green(ByVal mlColor As Long) As Long
    '从RGB值中获得绿色值
    Green = (mlColor \ &H100) And &HFF
End Function
Private Function Blue(ByVal mlColor As Long) As Long
    ''从RGB值中获得蓝色值
    Blue = (mlColor \ &H10000) And &HFF
End Function

Answer 10

用 API：GetPixel 来获得BITMAP的每一个BIT,然后除以&H10101,写回picturebox(API：SetpixelV),再乘以&H10101,写回picturebox即可获单色位图。如何保存该图像就要
你自己想办法了。
函数声明在apiload.exe中找。
'
'need a picturebox named pic1 on  form1
'
me.pic1.scalemode=3' scale by pixel
me.pic1.picture=loadpicture(picname)'picname is the file you want to open
for x=0 to me.pic1.scalewidth
 for y=0 to me.pic1.scaleheight
 SetPixelV Me.pic1.hdc, x, y, GetPixel(Me.pic1.hdc, x, y) / &H10101
 SetPixelV Me.pic1.hdc, x, y, GetPixel(Me.pic1.hdc, x, y) * &H10101
 next y
next x

Answer 11

如果是BMP文件那太好办了，只要把像素区里的一个像素的每个RGB相加，然后整除三再原样存回去。