15899.html
来自「以电子书的形式收集了VB一些常见问题解决方法,可以很方便的查找自己需要解决的问题」· HTML 代码 · 共 22 行
HTML
22 行
<html>
<head>
<title>请教safeaarray 与varptr的使用</title>
</head>
<body bgcolor="#FFFFFF" vlink="#808080">
<center>
<h1>请教safeaarray 与varptr的使用</h1>
</center>
<hr size=7 width=75%>
<hr size=7 width=75%><p>
Posted by <a href="mailto:ching9@wusnet.net.tw">ching</a> on July 20, 1999 at 10:54:41:<p>
以下程式实在体会不出来,请帮忙,谢谢<br>程式码如下:<br>Private Type SAFEARRAYBOUND<br> cElements As Long<br> lLbound As Long<br>End Type<p>Private Type SAFEARRAY1D<br> cDims As Integer<br> fFeatures As Integer<br> cbElements As Long<br> cLocks As Long<br> pvData As Long<br> Bounds(0 To 0) As SAFEARRAYBOUND<br>End TypePrivate Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long<br>﹝部份宣告省略﹞<br>Sub DoFlame()<br>' these are used to address the pixel using matrices<br>Dim pict() As Byte<br>Dim sa As SAFEARRAY1D, bmp As BITMAP<br>Dim r As Integer, c As Integer, value As Byte<br> <br>' get bitmap info<br>GetObjectAPI Pictbox.Picture, Len(bmp), bmp<br>' exit if not a supported bitmap<br>If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then<br> MsgBox " 256-color bitmaps only", vbCritical<br> Exit Sub<br>End If<br> <br>' have the local matrix point to bitmap pixels<br>With sa<br> .cbElements = 1<br> .cDims = 2<br> .Bounds(0).lLbound = 0<br> .Bounds(0).cElements = bmp.bmHeight<br> .Bounds(1).lLbound = 0<br> .Bounds(1).cElements = bmp.bmWidthBytes<br> .pvData = bmp.bmBits<br>End With<br>CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4<br> <br>' swap colors - note that col/row order is inverted<br>' because VB arrays are stored in column-wise order<br>For c = 0 To UBound(pict, 1)<br> pict(c, 0) = Int(Rnd(1) * 200) + 55<br>Next<br>For c = 1 To UBound(pict, 1) - 1<br> For r = 1 To UBound(pict, 2)<br> pict(c, r) = div3_lookup2(pict(c, r - 1)) + div3_lookup1(pict(c - 1, r - 1)) + div3_lookup3(pict(c + 1, r - 1))<br> Next<br>Next<br>' clear the temporary array descriptor<br>' without destroying the local temporary array<br>CopyMemory ByVal VarPtrArray(pict), 0&, 4<br>' inform VB that something has changed<br>Pictbox.Refresh<p>End Sub<p>
<br>
<br><hr size=7 width=75%><p>
<a name="followups">Follow Ups:</a><br>
<ul><!--insert: 15899-->
</ul><!--end: 15899-->
<br><hr size=7 width=75%><p>
</body></html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?