大橙子网站建设,新征程启航
为企业提供网站建设、域名注册、服务器等服务
我昨天刚用过,效果很好,速度也快
目前创新互联已为上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
保存前加一句 myImage2.SetResolution(300, 300) 你设置的bMape不是保存的主画布 所以无效,设置分辨率就是 SetResolution(X,Y)
可以将打印机默认打印设置改为黑白打印,如果打印对象是RGB配色,打印机驱动转换为CMYK颜色时,黑色都是由彩色墨水组成的
2.可以试一下图片从一个标准灰度图片格式化而来,这样图片自身只有黑白色,也许可以