sdgts
路人甲
路人甲
  • 注册日期2004-10-10
  • 发帖数114
  • QQ
  • 铜币550枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1651回复:3

[求助]请教怎样在blob字段存放图片?

楼主#
更多 发布于:2007-09-09 07:34
在属性表中已经添加属性为blob的字段,请教怎样在blob字段存放图片?
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15951
  • QQ
  • 铜币25345枚
  • 威望15368点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2007-09-09 13:39
<P>
<TABLE>

<TR>
<TD class=postvalue>下面的代码可以实现</TD></TR>
<TR>
<TH> </TH>
<TD><PRE>Sub Test()
    
    Dim pBlobTable As ITable
    ' (creates it if it doesn't already exist)
    Set pBlobTable = GetBlobTable("D:\arcgis\sampledata\MyGDB.mdb", "MyBlobs")
    If pBlobTable Is Nothing Then Exit Sub
    
    Dim pPictDisp As IPictureDisp
    Set pPictDisp = LoadPicture("D:\Pictureblobs.bmp")
    
    ' save the picture to the blob
    Picture2Blob pBlobTable, pPictDisp, "MyNewPicture"
        
    ' restore a previously saved picture
    Set pPictDisp = Blob2Picture(pBlobTable, "MyPicture")
    
    ' add the picture to the layout
    If pPictDisp Is Nothing Then
        Debug.Print "unable to load picture from blob"
    Else
        Dim pEnv As IEnvelope
        Set pEnv = New Envelope
        pEnv.PutCoords 1, 1, 2, 2 ' location on the layout for the element
        Dim pMxDoc As IMxDocument
        Set pMxDoc = ThisDocument
        AddPictureToLayout pPictDisp, pMxDoc.PageLayout, pEnv
    End If
    
End Sub

Sub AddPictureToLayout(pPictDisp As IPictureDisp, pGC As IGraphicsContainer, _
                       pEnv As IEnvelope)
    ' there's probably a better way to do this where
    ' you don't write it to a file
    SavePicture pPictDisp, "C:\temp\junk.bmp"
    Dim pPictElement As IPictureElement
    Set pPictElement = New BmpPictureElement
    pPictElement.ImportPictureFromFile "C:\temp\junk.bmp"
    pPictElement.SavePictureInDocument = True
    pPictElement.MaintainAspectRatio = True
    Dim dEnvAspRatio As Double
    dEnvAspRatio = pEnv.Width / pEnv.Height
    
    If pPictElement.PictureAspectRatio > dEnvAspRatio Then
        pEnv.Expand pPictElement.PictureAspectRatio / dEnvAspRatio, 1#, True
    Else
        pEnv.Expand 1#, dEnvAspRatio / pPictElement.PictureAspectRatio, True
    End If

    Dim pElement As IElement
    Set pElement = pPictElement
    pElement.Geometry = pEnv
    pGC.AddElement pElement, 0
    Dim pAV As IActiveView
    Set pAV = pGC
    pAV.PartialRefresh esriViewGraphics, pElement, Nothing
End Sub

Function Blob2Picture(pBlobTable As ITable, strName As String) As IPictureDisp
    ' using Name as a key, retrieve the picture from the blob field
    
    Dim pRow As IRow
    Set pRow = GetBlobRow(pBlobTable, strName, False)
    If Not pRow Is Nothing Then
        Dim pMemBlobStream As IMemoryBlobStream
        Set pMemBlobStream = pRow.Value(pRow.Fields.FindField("Blob"))
        
        Dim pPersistStream As IPersistStream
        Set pPersistStream = New StdPicture
        
        pPersistStream.Load pMemBlobStream
        Set Blob2Picture = pPersistStream
    Else
        Debug.Print "no row found for : " ; strName
        Set Blob2Picture = Nothing
    End If
End Function

Function GetBlobTable(strPath As String, strName As String) As ITable
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New AccessWorkspaceFactory
    
    Dim pFWS As IFeatureWorkspace
    Set pFWS = pWSF.OpenFromFile(strPath, 0)
    
    On Error Resume Next
    Set GetBlobTable = pFWS.OpenTable(strName)
    If GetBlobTable Is Nothing Then
        Set GetBlobTable = CreateBlobTable(strPath, strName)
    End If
End Function

Sub Picture2Blob(pBlobTable As ITable, pPictDisp As IPictureDisp, strName As String)
    ' saves the picture to a blob
    
    Dim pMemBlobStream As IMemoryBlobStream
    Set pMemBlobStream = New MemoryBlobStream
    
    Dim pPersistStream As IPersistStream
    Set pPersistStream = pPictDisp
    pPersistStream.Save pMemBlobStream, False
    
    Dim pRow As IRow
    Set pRow = GetBlobRow(pBlobTable, strName, True)
    pRow.Value(pRow.Fields.FindField("Name")) = strName
    pRow.Value(pRow.Fields.FindField("Blob")) = pMemBlobStream
    pRow.Store
    
End Sub

Function GetBlobRow(pBlobTable As ITable, strName As String, _
                      Optional bCreate As Boolean = False) As IRow
    Dim pQF As IQueryFilter
    Set pQF = New QueryFilter
    pQF.WhereClause = "[Name] = '" ; strName ; "'"
    Set GetBlobRow = pBlobTable.Search(pQF, False).NextRow
    ' if no row was found ...
    If GetBlobRow Is Nothing And bCreate Then
        Set GetBlobRow = pBlobTable.CreateRow ' ... then create one
    End If
End Function

Function CreateBlobTable(strPath As String, strName As String) As ITable
    Dim pWSF As IWorkspaceFactory
    Set pWSF = New AccessWorkspaceFactory
    
    Dim pFWS As IFeatureWorkspace
    Set pFWS = pWSF.OpenFromFile(strPath, 0)
            
    On Error Resume Next
    If pFWS.OpenTable(strName) Is Nothing Then
        Dim pCLSID As New UID
        pCLSID.Value = "esriCore.Object"
        Set CreateBlobTable = pFWS.Createtable(strName, MakeFields, _
                                               pCLSID, Nothing, "")
    Else
        ' don't create it if it already exists, just open it
        Set CreateBlobTable = pFWS.OpenTable(strName)
    End If
End Function

Function MakeFields() As IFields
    Dim pFldsEdit As IFieldsEdit
    Set pFldsEdit = New Fields
    
    Dim pFldEdit As IFieldEdit
    ' make the OID field
    Set pFldEdit = New Field
    With pFldEdit
        .IsNullable = False
        .Name = "OBJECTID"
        .Type = esriFieldTypeOID
        .Editable = True
        .Required = True
    End With
    pFldsEdit.AddField pFldEdit
    
    ' make the Name field
    Set pFldEdit = New Field
    pFldEdit.Name = "Name"
    pFldEdit.Type = esriFieldTypeString
    pFldEdit.Length = 50
    pFldsEdit.AddField pFldEdit
    ' make the blob field
    Set pFldEdit = New Field
    pFldEdit.Name = "Blob"
    pFldEdit.Type = esriFieldTypeBlob
    'pfldedit.Length = ???
    pFldsEdit.AddField pFldEdit
    Set MakeFields = pFldsEdit
End Function
</PRE> </TD></TR></TABLE></P>
GIS麦田守望者,期待与您交流。
举报 回复(0) 喜欢(0)     评分
sdgts
路人甲
路人甲
  • 注册日期2004-10-10
  • 发帖数114
  • QQ
  • 铜币550枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2007-09-09 16:57
请教在arcmap中怎样显示存放在blob中的图片。
举报 回复(0) 喜欢(0)     评分
sdgts
路人甲
路人甲
  • 注册日期2004-10-10
  • 发帖数114
  • QQ
  • 铜币550枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2007-09-10 13:54
请教在arcmap中怎样显示存放在blob中的图片。
举报 回复(0) 喜欢(0)     评分
游客

返回顶部