栅格数据读写(100分)

用Ａｏ编程：栅格数据读写不能正常进行
Option Explicit
Private m_app As IApplication
Private m_Map As IMap
Private m_GeoIn As IGeoDataset
Private m_GeoIn0 As IGeoDataset
Dim layername As String
Private m_CreateDrop As Boolean
Private m_ForceFlowAtEdge As Boolean
Public g_pApp As IApplication
Public g_pEditRas As IRaster
Public g_pEditBand As IRasterBand
Dim pRaw As IRawPixels
Public g_pTrans As IRasterTransaction
Public g_PixelType As rstPixelType
Public x As Integer
Private Sub cboDemInput_Change()
End Sub
Public Sub cmdBrowseInput_Click()
' On Error GoTo erh
Dim xx As Variant
Dim pCache
Dim xp As Integer, xq As Integer, yq As Integer, yp As Integer
Dim vArr As Variant
Dim pRDS As IRasterDataset
Set pRDS = comm.AddInputFromGxBrowser(cboDemInput, flowdirection)
If pRDS Is Nothing then
Exit Sub
End If
Set m_GeoIn = pRDS.CreateDefaultRaster
Set g_pEditRas = pRDS.CreateDefaultRaster
comm.AddRasterLayer m_app, m_GeoIn, cboDemInput.Text
layername = cboDemInput.Text + "1"
'
Dim pRasProps As IRasterProps
Set pRasProps = m_GeoIn
Dim pBand As IRasterBand
Dim pBandCol As IRasterBandCollection
Set pBandCol = pRDS
Set pBand = pBandCol.Item(0)
' QI RawPixel interface
Dim pRawpixel As IRawPixels
Set pRawpixel = pBand
' Create a DblPnt to hold the PixelBlock size
Dim pSize As IPnt
Set pSize = New DblPnt
pSize.SetCoords pRasProps.Width, pRasProps.Height

' Create PixelBlock with defined size
Dim pBlock As IPixelBlock
Set pBlock = pRawpixel.CreatePixelBlock(pSize)
Set pRaw = g_pEditBand
'

'vArr = pBlock.SafeArray(0)
' Get the SafeArray associated with the first band
Dim vNoDataValue As Variant
vNoDataValue = pRasProps.NoDataValue
' Dim pSafeArray As Variant

' pSafeArray = pBlock.SafeArray(0)
' Create a DblPnt to hold the top left corner
Dim pPnt As IPnt
Set pPnt = New DblPnt
pPnt.SetCoords 0, 0

' Write the PixelBlock to raster band
pRawpixel.Read pPnt, pBlock
vArr = pBlock.SafeArray(0)

xp = LBound(vArr, 1)
yp = LBound(vArr, 2)
xq = UBound(vArr, 1)
yq = UBound(vArr, 2)

' Loop through the SafeArray and set value to each pixel
' ReDim vArr(1000, 1000) As Variant
'ReDim vArr(1000, 1000) As Integer
' ReDim pSafeArray(1000, 1000) As Variant
Dim pPB As IPixelBlock3
' Set pPB = CT_CreateAndReadPixelBlockForEntireRaster(g_pEditRas)
Set pPB = pRawpixel.CreatePixelBlock(pSize)
Dim y As Integer
Dim I, j As Integer
For I = xp To xq - 1 ' pSize.x - 1
For j = yp To yq - 1 ' pSize.y - 1
' x = vArr(i, j)
Dim pCurrentCellPoint As IPoint
Set pCurrentCellPoint = New Point
pCurrentCellPoint.PutCoords I, j
Dim vCellValue As Variant
vCellValue = pPB.GetVal(0, CLng(pCurrentCellPoint.x), CLng(pCurrentCellPoint.y))

'If vArr(i, j) <> pRasProps.NoDataValue then
If vArr(I, j) And j = 200 then
'<> &iexcl;&macr;vNoDataValue

vArr(I, j) = 100

End If
' pSafeArray(i, j) = i + j
Next j
Next I


' g_pTrans.Start
pBlock.SafeArray(0) = vArr
' pBlock.SafeArray(0) = pSafeArray
'

Set pCache = pRawpixel.AcquireCache
'pBlock.SafeArray(0) = vArr
pRawpixel.Write pPnt, pBlock
pRawpixel.ReturnCache pCache
Set m_GeoIn0 = pRDS.CreateDefaultRaster

' g_pTrans.End
' Release memeory
Set pRawpixel = Nothing
Set pPnt = Nothing
Set pSize = Nothing
Set pBlock = Nothing
Set pBand = Nothing
Set pBandCol = Nothing
Set pRDS = Nothing
Set m_GeoIn = Nothing
Set pRasProps = Nothing
' Set pOrigin = Nothing
' Set pRWS = Nothing
'Set pWSF = Nothing


cmdok.Enabled = True
Exit Sub
ERH:
MsgBox &quot;cmdBrowseInput:&quot;
& Err.Description
End Sub
请教高手，谢谢