Sub LoadToRasterColumn(pTable As ITable, oid As Long, pRasterDs As IRasterDataset)

  'This procedure load pRasterDs to the raster field of the row with objectid
  'of oid in a table pTable
 

  Dim pRow As IRow
  Dim iRaster As Integer 'id for raster column
  Dim iCnt As Integer
  Dim pValue As IRasterValue
 
  Set pValue = New RasterValue
       
  Set pRow = pTable.GetRow(oid)
 
  iRaster = -1
   ' get the raster field id
 
  For iCnt = 0 To pTable.Fields.FieldCount - 1
    If pTable.Fields.Field(iCnt).Type = esriFieldTypeRaster Then
      iRaster = iCnt
      Exit For
    End If
  Next iCnt
 
  If iRaster = -1 Then
    MsgBox "no raster column exists in the table"
    Exit Sub
  End If
   
    ' set the raster dataset to the raster field
  Set pValue.RasterDataset = pRasterDs
  pRow.Value(iRaster) = pValue
  pRow.Store

    ' clean up
  Set pValue = Nothing
  Set pRow = Nothing

End Sub

Public Function OpenRasterDataset(sPath As String, sFileName As String) As IRasterDataset
    ' sPath: directory where dataset resides
    ' sFileName: name of the raster dataset
    On Error GoTo ErrorHandler
   
    ' Create RasterWorkSpaceFactory
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New RasterWorkspaceFactory
   
    ' Get RasterWorkspace
    Dim pRasWS As IRasterWorkspace
    If pWSF.IsWorkspace(sPath) Then
        Set pRasWS = pWSF.OpenFromFile(sPath, 0)
        Set OpenRasterDataset = pRasWS.OpenRasterDataset(sFileName)
    End If
   
    ' Release memeory
    Set pRasWS = Nothing
    Set pWSF = Nothing
    Exit Function
ErrorHandler:
    Set OpenRasterDataset = Nothing
End Function
Sub 添加图像()
    Dim pPropset As IPropertySet
    Set pPropset = New PropertySet
    pPropset.SetProperty "DATABASE", "D:遥感解驿数据库数据库四次监测遥感解译标志库-沙化.mdb"
    pPropset.SetProperty "DATAPROVIDER", "Access Data Source"
    Dim pwf As IWorkspaceFactory
    Set pwf = New AccessWorkspaceFactory
    Dim fws As IFeatureWorkspace
    Set fws = pwf.Open(pPropset, 0)
    'Open the Table
    Dim pTable As ITable
    Set pTable = fws.OpenTable("FieldPhoto_SH")
    Dim pRasterDs As IRasterDataset
    Dim Imgpath As String
    Dim Imgname As String '图片名称来自于图像标识文件
    Dim ImgID As Long
    Dim I As Long
    Dim Imgnum As Long
    Dim Imglistfile As String
     '输入图片所在文件夹
    Imgpath = "D:遥感解驿数据库TestPhoto"
    '输入图像标识文件名
    Imglistfile = "D:遥感解驿数据库TestPhotofilelist.txt"
    Imgnum = 8
    Open Imglistfile For Input As #1
    For I = 1 To Imgnum
       
        ImgID = I
        Line Input #1, Imgname
        Set pRasterDs = OpenRasterDataset(Imgpath, Imgname)
        Call LoadToRasterColumn(pTable, ImgID, pRasterDs)
      
    Next

  
    '.CreateRasterDataset(sDsName, iNBands, iPixelType, _
      pRasterStoreDef, sKeyword, pRasterDef, pGeoDef)

    'Create new row
    'Dim pCursor As ICursor
    'Dim arow As IRow
    'Dim pRowBuff As IRowBuffer
    'Set pRowBuff = pTable.CreateRowBuffer
    'Populate the row with values
    'Dim result As Integer
   

   ' pRowBuff.Value(1) = 100        'Numeric column
   ' pRowBuff.Value(2) = "Canada"   'Text column
   'pRowBuff.Value
   ' Set pCursor = pTable.Insert(True)
   ' pCursor.InsertRow pRowBuff
   Close #1
End Sub

转载本文请联系原作者获取授权，同时请注明本文来自付安民科学网博客。
链接地址：https://blog.sciencenet.cn/blog-219445-332045.html

上一篇：NDVI的前世
下一篇：VBA读取word文档表格中table的cell的text文本