15899.html

来自「VB技巧问答10000例,是一个教程」· 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 + -
显示快捷键?