阅读:1652回复:3
[求助]请教怎样在blob字段存放图片?
在属性表中已经添加属性为blob的字段,请教怎样在blob字段存放图片?
|
|
1楼#
发布于:2007-09-10 13:54
请教在arcmap中怎样显示存放在blob中的图片。
|
|
2楼#
发布于:2007-09-09 16:57
请教在arcmap中怎样显示存放在blob中的图片。
|
|
3楼#
发布于: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> |
|
|