将JPG转灰度然后二值化，速度，显示和打印的问题

[CoolCHEN]

我刚学了一点：

Private Sub command1_click()
Dim r As Long, g As Long, b As Long, st As Long, gray As Long
Dim x, y, mid, t
mid = Text1 '阙值
t = Timer
For x = 1 To 800
For y = 1 To 600
st = P1.Point(x, y)
r = st Mod &H100
g = (st \ &H100) Mod &H100
b = (st \ &H10000) Mod &H100
gray = IIf(0.299 * r + 0.587 * g + 0.114 * b > mid, 255, 0)
gray = RGB(gray, gray, gray)
P2.PSet (x, y), gray
Next
Next
MsgBox Timer - t
End Sub

我是先加载到P1（picture），然后在P2中显示
1、如果p1不把图片显示全width<scalewidth，那p2中也就不完全了。我希望不加载原JPG，直接显示处理后的效果
2、用point pset速度很慢，getpixel也慢，还有什么好方法
3、PICTURE有没有通用的放大，缩小，平移，打印程序
4、打印能不能选定某个区域，根据A4纸张，满幅打印

[CoolCHEN]

2.3.4 还是不太清楚

[laviewpbt]

2 DIB
3 API
4 API

[Summer006]

1,你现在的方法，必须要加载原jpg吧。你可以设置picturebox的宽度为图片宽度啊， autosize属性设置为auto即可。 原图不显示出来的话再设置visible为false。
2，好方法有，难度较高。
3，paint方法可以实现缩放平移，具体看帮助。
4，打印就不清楚了。没有做过，不过想应该比较简单

[Summer006]

呵呵。没想到你还学的挺快。
SetDIBits的方法我用过，感觉速度还有提升的空间。
后来我就研究了array2D（），速度还不错。感觉已经到vb图像处理的极限了。

如果lz有兴趣，可以联系我，手头有个array2D（）方法的图像处理源码程序可以给你看看，以前我也是看这个程序，研究了一阵子才搞懂array2D（）的。

[韧恒]

大致看了一下你的代码，说一下我的速度提升建议：
1. 看下这个例子，http://www.vb99.com/loaddown.asp?tid=1&pathid=5&Filenames=118, 是一个按任意色深的图像建立异形窗口的例子，看一下他是如何操作DIB的，这种直接获取数组地址的方式应该比你的方法更快。
2. 转灰度时不要使用0.299等这些浮点数，我记得我测试过，两次整数运算往往比一次浮点的计算还要快。（你再试下，如(x \ 4) * 3 应该比 X * 0.75快些)
3. 将IIF函数改写成if ... then ... end if语句

[CoolCHEN]

第2个问题学习了一下，基本用DIB写出来了，读写像素的确快多了，但是转灰度二值化的算法还是很慢

Private Sub Command2_Click()
Dim i As Long, L As Long
Dim x, y, s, gray As Long
Dim mid, t
t = Timer
DibGet P1.hdc, 0, 0, P1.ScaleWidth, P1.ScaleHeight
CopyData InPutHei, InPutWid
i = Bits \ 8
L = i - 1
ReDim ColVal(L, InPutHei, InPutWid)
mid = Text1 '阙值
For x = 0 To InPutHei - 1
For y = 0 To InPutWid - 1
gray = IIf(0.299 * ColOut(0, x, y) + 0.587 * ColOut(1, x, y) + 0.114 * ColOut(2, x, y) > mid, 255, 0)
For s = 0 To 2
ColVal(s, x, y) = gray
Next
Next
Next
DIBPut P2.hdc
P2.Refresh
MsgBox Timer - t
End Sub

模块：声明省略：
Public Sub DibGet(ByVal IdSource As Long, XBegin As Long, ByVal YBegin As Long, ByVal XEnd As Long, ByVal YEnd As Long)
Dim iBitmap As Long
Dim iDC As Long
Dim i As Long
Dim W As Long
Dim H As Long

On Error GoTo ErrLine

InPutWid = XEnd - XBegin
InPutHei = YEnd - YBegin
W = InPutWid + 1
H = InPutHei + 1

i = (Bits \ 8) - 1
ReDim ColVal(i, InPutWid, InPutHei)
With bi24BitInfo.bmiHeader
.biBitCount = Bits
.biCompression = 0&
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = W
.biHeight = H
End With

iBitmap = GetCurrentObject(IdSource, 7&)
GetDIBits IdSource, iBitmap, 0&, H, ColVal(0, 0, 0), bi24BitInfo, 0&
DeleteObject iBitmap
Exit Sub

ErrLine:
MsgBox "错误号：" & Err.Number & "：" & Err.Description
End Sub

Public Sub DIBPut(ByVal IdDestination As Long)
Dim W As Long
Dim H As Long

On Error GoTo ErrLine

W = InPutWid + 1
H = InPutHei + 1

With bi24BitInfo.bmiHeader
.biWidth = W
.biHeight = H
.biSizeImage = ((W * Bits + 31) And &HFFFFFFE0) \ 8 * H
End With

SetDIBitsToDevice IdDestination, 0, 0, W, H, 0, 0, 0, H, ColOut(0, 0, 0), bi24BitInfo, 0

Exit Sub
ErrLine:
MsgBox Err.Description
End Sub

Public Sub CopyData(ByVal W As Long, ByVal H As Long)
Dim Length As Long
Dim i As Long
Dim L As Long
i = Bits \ 8
L = i - 1
Length = (W + 1&) * (H + 1&) * i
ReDim ColOut(L, W, H)
CopyMemory ColOut(0, 0, 0), ColVal(0, 0, 0), Length
End Sub

[CoolCHEN]

SetDIBitsToDevice IdDestination, 0, 0, W, H, 0, 0, 0, H, ColOut(0, 0, 0), bi24BitInfo, 0

这个应该是 ColVal(0, 0, 0)

800*600 速度1.5s