图像处理 英文翻译

private declare function varptrarray lib "msvbvm60.dll" alias "varptr" _
(ptr() as any) as long
private declare sub copymemory lib "kernel32" alias "rtlmovememory" _
(pdst as any, psrc as any, byval bytelen as long)
private declare function getobj lib "gdi32" alias "getobjecta" _
(byval hobject as long, byval ncount as long, lpobject as any) as long

private type safearraybound
celements as long
llbound as long
end type

private type safearray2d
cdims as integer
ffeatures as integer
cbelements as long
clocks as long
pvdata as long
bounds(0 to 1) as safearraybound
end type

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 varptrarray lib "msvbvm60.dll" alias "varptr" _
(ptr() as any) as long
private declare sub copymemory lib "kernel32" alias "rtlmovememory" _
(pdst as any, psrc as any, byval bytelen as long)
private declare function getobj lib "gdi32" alias "getobjecta" _
(byval hobject as long, byval ncount as long, lpobject as any) as long

private type safearraybound
celements as long
llbound as long
end type

private type safearray2d
cdims as integer
ffeatures as integer
cbelements as long
clocks as long
pvdata as long
bounds(0 to 1) as safearraybound
end type

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

使用VarPtr函数可以得到一个变量的内存地址,在此,我也引用了一个可以指向数组的函数VarPtrArray.

使用CopyMemory则可以将数据从一块内存复制到另一块内存.

使用GetObj则可以获得一个对象的内存,在例子中我们用它来得到StdPicture对象的信息.因此,我们需要定义一个位图结构.

最后我们定义了一个安全数组结构,我们用它来替换实际工作的数组.

我们先定义StdPicture对象,并且假设它已经加载了一个图像. 再定义一个动态数组而不初始化. 我们使用API来将这个数组"分配"到图像的内存,这样,我们在数组上的任何改动就能显示在图像上了. 代码:

dim sa as safearray2d
dim bmp as bitmap
dim mvarbytesperpixel

public sub loadpicarray(p as stdpicture,data() as byte)
if getobj(p.handle, len(bmp), bmp) then '获取图像信息
mvarbytesperpixel = bmp.bmwidthbytes \ bmp.bmwidth
'将数组映射到图像
with sa
.cbelements = 1
.cdims = 2
.bounds(0).llbound = 0
.bounds(0).celements = bmp.bmheight
.bounds(1).llbound = 0
.bounds(1).celements = bmp.bmwidthbytes
.pvdata = bmp.bmbits
end with
'拷贝数组信息
copymemory byval varptrarray(data), varptr(sa), 4
end if
end sub
dim sa as safearray2d
dim bmp as bitmap
dim mvarbytesperpixel

public sub loadpicarray(p as stdpicture,data() as byte)
if getobj(p.handle, len(bmp), bmp) then '获取图像信息
mvarbytesperpixel = bmp.bmwidthbytes \ bmp.bmwidth
'将数组映射到图像
with sa
.cbelements = 1
.cdims = 2
.bounds(0).llbound = 0
.bounds(0).celements = bmp.bmheight
.bounds(1).llbound = 0
.bounds(1).celements = bmp.bmwidthbytes
.pvdata = bmp.bmbits
end with
'拷贝数组信息
copymemory byval varptrarray(data), varptr(sa), 4
end if
end sub

看看发生了什么? 首先我们用GetObj来获取了位图的信息,然后使用这个信息来构造了SafeArray2d结构,特别注意这句:

.pvdata = bmp.bmbits

它将位图位图所在的内存指向了结构.

简单把, 不尽然,这里有些需要注意的地方:

1:图像对象必须预先载入一个图片才能建立一个位图结构,否则它是没有意义的.

2:安全数组对象必须和数组的生存周期一致,如果你在数组被回收之前就释放了安全数组对象,那么数组将无处可指(导致VB崩溃)

3:而在释放数组之前,又必须将数组还原,否则程序会因为内存泄漏而崩溃.

4:一个256色的位图中,每个像素占用1个字节,但是这个字节只是对应了一个调色板索引而并非一个实际的颜色值. 所以你必须在建立数组之前先把索引转换成时机颜色.(这里不讨论16位色) 幸运的是24位色图像中存放的是真正的颜色值,但你依然需要颜色对应到RGB字节中

5:通常来说,位图对应的数组是从左下角开始的,因此数组(0,0)对应图像的最左下角的点

在你弄完之后,你必须复位数组,见下:

view plaincopy to clipboardprint?
public sub releasedata(a() as byte)
copymemory byval varptrarray(a), 0&, 4
end sub
public sub releasedata(a() as byte)
copymemory byval varptrarray(a), 0&, 4
end sub

那么现在这个数组是什么呢?它变成了一个2维数组(X,Y),X代表横坐标,Y代表纵坐标,每一个数组元素是一个字节. 对于256色位图来说,这个字节是一个颜色索引,但对于24位色图像来说,它是一个颜色值. 每个字节对应了颜色值中的RGB中的一个,所以每个像素是有3个个数组元素组成的.例如:一个100X100的图像对应一个300X100大小的数组.

数组的大小相对于像素是不同的,因此你当你读写某个像素的时候必须自己计算:

view plaincopy to clipboardprint?
public sub drawpixel(data() as byte, byval x&, byval y&, byval c&)
select case mvarbytesperpixel
case 1: data(x, y) = c and &hff
case 2: data(x + x, y) = (c \ 256) and &hff
data(x + x + 1, y) = c and &hff
case 3: data(x * 3, y) = (c \ 65536) and &hff
data(x * 3 + 1, y) = (c \ 256) and &hff
data(x * 3 + 2, y) = c and &hff
end select
end sub

public function readpixel(data() as byte, byval x&, byval y&) as long
select case mvarbytesperpixel
case 1: readpixel = data(x, y)
case 2: readpixel = data(x + x, y) * 256& + data(x + x + 1, y)
case 3: readpixel = ((data(x * 3, y) * 256&) + data(x * 3 + 1, y)) * 256& + data(x * 3 + 2, y)
end select
end function
public sub drawpixel(data() as byte, byval x&, byval y&, byval c&)
select case mvarbytesperpixel
case 1: data(x, y) = c and &hff
case 2: data(x + x, y) = (c \ 256) and &hff
data(x + x + 1, y) = c and &hff
case 3: data(x * 3, y) = (c \ 65536) and &hff
data(x * 3 + 1, y) = (c \ 256) and &hff
data(x * 3 + 2, y) = c and &hff
end select
end sub

public function readpixel(data() as byte, byval x&, byval y&) as long
select case mvarbytesperpixel
case 1: readpixel = data(x, y)
case 2: readpixel = data(x + x, y) * 256& + data(x + x + 1, y)
case 3: readpixel = ((data(x * 3, y) * 256&) + data(x * 3 + 1, y)) * 256& + data(x * 3 + 2, y)
end select
end function

这里给出一个速度对比:

加载一个100X100的24位图像, 我把每个像素都设置为红色,使用DMA,SetPixel和PSet时间分别为:5ms,60ms,550ms. 编译之后,分别为:4ms,50ms,70ms. DMA比SetPixel快12倍

附上封装好的模块, 只要把它编译为ActiveX DLL然后就可以在你自己的工程中引用它.

下面是我的测试工程,演示了使用方法:

view plaincopy to clipboardprint?
option explicit
private declare function getpixel lib "gdi32" _
(byval hdc as long, byval x as long, byval y as long) as long
private declare function setpixel lib "gdi32" _
(byval hdc as long, byval x as long, byval y as long, byval crcolor as long) as long
private declare function timegettime lib "winmm.dll" () as long
dim pa as bchpicarray.clspicarray

private sub command1_click()
dim x&, y&, t&
t = timegettime()
for y = 0 to picture1.scaleheight - 1
for x = 0 to picture1.scalewidth - 1
pa.drawpixel x, y, vbred
next x
next y
t = timegettime() - t
picture1.refresh
me.caption = "picarray=" & t

t = timegettime()
for y = 0 to picture1.scaleheight - 1
for x = 0 to picture1.scalewidth - 1
setpixel picture1.hdc, x, y, vbred
next x
next y
t = timegettime() - t
picture1.refresh
me.caption = me.caption & " setpixel=" & t

t = timegettime()
for y = 0 to picture1.scaleheight - 1
for x = 0 to picture1.scalewidth - 1
picture1.pset (x, y), vbred
next x
next y
t = timegettime() - t
picture1.refresh
me.caption = me.caption & " pset=" & t
end sub

private sub form_load()
set pa = new clspicarray
pa.loadpicarray picture1.picture
end sub

private sub form_unload(cancel as integer)
set pa = nothing
end sub