vb点虐 图片黑白比 vb设置背景图片与窗体一样大

如何用vb编程将彩色图像转换为黑白

我昨天刚用过，效果很好，速度也快

目前创新互联已为上1000+的企业提供了网站建设、域名、网页空间、网站托管、服务器租用、企业网站设计、石家庄网站维护等服务，公司将坚持客户导向、应用为本的策略，正道将秉承"和谐、参与、激情"的文化，与客户和合作伙伴齐心协力一起成长，共同发展。

（代码在下面地址的7楼）

一个用API来完成的例子, 速度比GetPixel快n倍

Option Explicit

'图像处理的一个例子

'Powered by Jadeluo , 2004/02/21

'EMail: Jadeluo@sina点抗

Private Type BITMAP

bmType As Long

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()

picShow.BorderStyle = vbBSNone

picShow.Move 0, 0

End Sub

Private Sub cmdLoad_Click()

On Error Resume Next

With CommonDialog1

.Filter = "Picture(*.BMP;*.JPG;*.GIF;*.ICO)|*.BMP;*.JPG;*.GIF;*.ICO|All Files(*.*)|*.*"

.CancelError = True

.ShowOpen

If Err.Number = 0 Then

picShow.AutoSize = True

picShow.Picture = LoadPicture(.FileName)

End If

End With

On Error GoTo 0

End Sub

Private Sub cmdGray_Click()

Dim PicBits() As Byte, PicInfo As BITMAP, BytesPerPixel As Long

Dim R As Byte, G As Byte, B As Byte, Gray As Byte, i As Long

With picShow

.AutoRedraw = True

GetObject .Image, Len(PicInfo), PicInfo

BytesPerPixel = PicInfo.bmBitsPixel \ 8

ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * BytesPerPixel)

GetBitmapBits .Image, UBound(PicBits), PicBits(1)

For i = 0 To UBound(PicBits) \ BytesPerPixel - 1

B = PicBits(i * BytesPerPixel + 1)

G = PicBits(i * BytesPerPixel + 2)

R = PicBits(i * BytesPerPixel + 3)

Gray = R * 0.39 + G * 0.5 + B * 0.11

'下面这一句是将灰度值换算成二值

' If Gray 127 Then Gray = 255 Else Gray = 0

PicBits(i * BytesPerPixel + 1) = Gray

PicBits(i * BytesPerPixel + 2) = Gray

PicBits(i * BytesPerPixel + 3) = Gray

Next i

SetBitmapBits .Image, UBound(PicBits), PicBits(1)

.Refresh

End With

End Sub

vb点虐 保存图片时如何调整其分辨率

保存前加一句 myImage2.SetResolution(300, 300) 你设置的bMape不是保存的主画布 所以无效，设置分辨率就是 SetResolution（X,Y）

vb点虐 打印问题

可以将打印机默认打印设置改为黑白打印，如果打印对象是RGB配色，打印机驱动转换为CMYK颜色时，黑色都是由彩色墨水组成的

2.可以试一下图片从一个标准灰度图片格式化而来，这样图片自身只有黑白色，也许可以