frmproperties.frm

有关geomedia的一个全新的gis工程

VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmProperties 
   Caption         =   "Properties"
   ClientHeight    =   5430
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3870
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5430
   ScaleWidth      =   3870
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton Cmdok 
      Caption         =   "OK"
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      Top             =   5040
      Width           =   1095
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   4815
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   8493
      _Version        =   393216
      Tabs            =   2
      Tab             =   1
      TabsPerRow      =   2
      TabHeight       =   520
      TabCaption(0)   =   "General"
      TabPicture(0)   =   "FrmProperties.frx":0000
      Tab(0).ControlEnabled=   0   'False
      Tab(0).Control(0)=   "MSFlexGridGeneral"
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "Attributes"
      TabPicture(1)   =   "FrmProperties.frx":001C
      Tab(1).ControlEnabled=   -1  'True
      Tab(1).Control(0)=   "MSFlexGridAttributes"
      Tab(1).Control(0).Enabled=   0   'False
      Tab(1).ControlCount=   1
      Begin MSFlexGridLib.MSFlexGrid MSFlexGridAttributes 
         Height          =   4335
         Left            =   0
         TabIndex        =   2
         Top             =   360
         Width           =   3855
         _ExtentX        =   6800
         _ExtentY        =   7646
         _Version        =   393216
         AllowUserResizing=   1
      End
      Begin MSFlexGridLib.MSFlexGrid MSFlexGridGeneral 
         Height          =   4335
         Left            =   -75000
         TabIndex        =   3
         Top             =   360
         Width           =   3855
         _ExtentX        =   6800
         _ExtentY        =   7646
         _Version        =   393216
         GridLines       =   2
      End
   End
End
Attribute VB_Name = "FrmProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'use the attribute of Selected object to fill the FlexGrid
'include General information and attributes
Public Sub FillFlexGrid(SelectObject As Object)
On Error GoTo errhandle
  Dim objRS     As GRecordset
  Dim vBookMark   As Variant
  Dim objMeas As New MeasurementService
  Dim objUOM As New UnitsOfMeasure
  Dim dblMiles As Double, lngInUnit As Long, lngOutUnit As Long
  Dim strOutputUnit As String

  Dim FieldCount As Integer
  Dim i As Integer
  
  'set the CoordSystem of mapview to objMeas
  With objMeas
  Set .CoordSystem = FrmMain.GMMapView1.CoordSystemsMgr.CoordSystem
  .ReferenceSpace = gmcssProjection
  End With

  'locate the current selected record
  Set objRS = SelectObject.Recordset
  vBookMark = SelectObject.Bookmark
  objRS.Bookmark = vBookMark
  
  'set the grid's row number
  FieldCount = objRS.GFields.Count
  MSFlexGridAttributes.Rows = FieldCount + 1
  MSFlexGridAttributes.Col = 1
  
  'fill the grid
  For i = 0 To FieldCount - 1
      MSFlexGridAttributes.Row = i + 1
      MSFlexGridAttributes.CellAlignment = 0
      MSFlexGridAttributes.TextMatrix(i + 1, 0) = objRS.GFields(i).SourceField
      
      ' if the GField is not a geometry field
      If objRS.GFields(i).Type < 32 Then
            If IsNull(objRS.GFields(i).Value) Then
              MSFlexGridAttributes.TextMatrix(i + 1, 1) = ""
            Else
              Select Case objRS.GFields(i).Type
                     Case 2 To 8   'numeric type
                          MSFlexGridAttributes.TextMatrix(i + 1, 1) = LTrim(Str(objRS.GFields(i).Value))
                     Case 1        'boolean type
                        If objRS.GFields(i).Value Then
                           MSFlexGridAttributes.TextMatrix(i + 1, 1) = "true"
                        Else
                           MSFlexGridAttributes.TextMatrix(i + 1, 1) = "false"
                        End If
                      Case 11  'Memo type
                           MSFlexGridAttributes.TextMatrix(i + 1, 1) = "Memo"
                      Case Else  'string type
                           MSFlexGridAttributes.TextMatrix(i + 1, 1) = objRS.GFields(i).Value
                         
               End Select
            End If
        Else 'if the gfield is a geometry field
            MSFlexGridAttributes.TextMatrix(i + 1, 1) = "Geometry object"
            Select Case objRS.GFields(i).SubType
                   Case 1 'Linear  type
                        MSFlexGridGeneral.Rows = 6
                        MSFlexGridGeneral.TextMatrix(1, 0) = "Feature Class"
                        MSFlexGridGeneral.TextMatrix(2, 0) = "Connection Name"
                        MSFlexGridGeneral.TextMatrix(3, 0) = "Discription"
                        MSFlexGridGeneral.TextMatrix(4, 0) = "Geometry Type"
                        MSFlexGridGeneral.TextMatrix(5, 0) = "Length"
                        
                        MSFlexGridGeneral.TextMatrix(1, 1) = objRS.GFields(i).SourceTable
                        MSFlexGridGeneral.TextMatrix(2, 1) = gobjConnection.ConnectionName
                        MSFlexGridGeneral.TextMatrix(3, 1) = gobjConnection.Description
                        MSFlexGridGeneral.TextMatrix(4, 1) = "Linear"
                        
                        lngInUnit = objUOM.GetUnitID(igUnitDistance, "m")
                        lngOutUnit = objUOM.GetUnitID(igUnitDistance, "m")
                        strOutputUnit = objUOM.GetUnitName(lngOutUnit)
                        
                        Set objMeas.geometry = BlobToGeometry(objRS.GFields(i).Value)
                        dblMiles = objUOM.ConvertUnitToUnit(igUnitDistance, objMeas.Length, _
                        lngInUnit, lngOutUnit)

                        MSFlexGridGeneral.TextMatrix(5, 1) = Format(dblMiles, "##.##") & _
                             " " & strOutputUnit

                   Case 2 'area type
                        MSFlexGridGeneral.Rows = 6
                        MSFlexGridGeneral.TextMatrix(1, 0) = "Feature Class"
                        MSFlexGridGeneral.TextMatrix(2, 0) = "Connection Name"
                        MSFlexGridGeneral.TextMatrix(3, 0) = "Discription"
                        MSFlexGridGeneral.TextMatrix(4, 0) = "Geometry Type"
                        MSFlexGridGeneral.TextMatrix(5, 0) = "Area"
                        
                        MSFlexGridGeneral.TextMatrix(1, 1) = objRS.GFields(i).SourceTable
                        MSFlexGridGeneral.TextMatrix(2, 1) = gobjConnection.ConnectionName
                        MSFlexGridGeneral.TextMatrix(3, 1) = gobjConnection.Description
                        MSFlexGridGeneral.TextMatrix(4, 1) = "Area"
                        
                        lngInUnit = objUOM.GetUnitID(igUnitArea, "m^2")
                        lngOutUnit = objUOM.GetUnitID(igUnitArea, "m^2")
                        strOutputUnit = objUOM.GetUnitName(lngOutUnit)
                        
                        Set objMeas.geometry = BlobToGeometry(objRS.GFields(i).Value)
                        dblMiles = objUOM.ConvertUnitToUnit(igUnitArea, objMeas.Area, _
                        lngInUnit, lngOutUnit)

                        MSFlexGridGeneral.TextMatrix(5, 1) = Format(dblMiles, "##.##") & _
                             " " & strOutputUnit

                   Case 10 'point type
                        MSFlexGridGeneral.Rows = 5
                        MSFlexGridGeneral.TextMatrix(1, 0) = "Feature Class"
                        MSFlexGridGeneral.TextMatrix(2, 0) = "Connection Name"
                        MSFlexGridGeneral.TextMatrix(3, 0) = "Discription"
                        MSFlexGridGeneral.TextMatrix(4, 0) = "Geometry Type"
                        
                        MSFlexGridGeneral.TextMatrix(1, 1) = objRS.GFields(i).SourceTable
                        MSFlexGridGeneral.TextMatrix(2, 1) = gobjConnection.ConnectionName
                        MSFlexGridGeneral.TextMatrix(3, 1) = gobjConnection.Description
                        MSFlexGridGeneral.TextMatrix(4, 1) = "Point"
                   Case Else
                   
            End Select
                         
        End If
        
  Next i
  
  Me.Show 1
  Exit Sub
errhandle:
  MsgBox Err.Description, MSGBOX_ERROR, "FillDataGrid"
End Sub

Private Sub CmdOK_Click()
   Unload Me
End Sub

Private Sub Form_Load()
    MSFlexGridAttributes.Col = 0
    MSFlexGridAttributes.Row = 0
    MSFlexGridAttributes.TextMatrix(0, 0) = "Name"
    MSFlexGridAttributes.TextMatrix(0, 1) = "Value"
    MSFlexGridAttributes.ColWidth(0) = MSFlexGridAttributes.Width / 2 - 300
    MSFlexGridAttributes.ColWidth(1) = MSFlexGridAttributes.Width / 2 - 100
    
    MSFlexGridGeneral.Col = 0
    MSFlexGridGeneral.Row = 0
    MSFlexGridGeneral.TextMatrix(0, 0) = "Name"
    MSFlexGridGeneral.TextMatrix(0, 1) = "Value"
    MSFlexGridGeneral.ColWidth(0) = MSFlexGridGeneral.Width / 2 - 300
    MSFlexGridGeneral.ColWidth(1) = MSFlexGridGeneral.Width / 2 - 100

End Sub