test_basatt.frm

mapgis二次开发,vb示例 mapgis二次开发,vb示例

VERSION 5.00
Object = "{90E45987-261F-4416-A3DF-90102A62977D}#1.0#0"; "AttStruEdit.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Object = "{24075224-9523-41F5-B041-AF891E546822}#1.0#0"; "GisAttEdit.ocx"
Begin VB.Form AttOper 
   AutoRedraw      =   -1  'True
   Caption         =   "属性操作"
   ClientHeight    =   3555
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5385
   Icon            =   "Test_BasAtt.frx":0000
   LinkTopic       =   "FormBas"
   ScaleHeight     =   3555
   ScaleWidth      =   5385
   StartUpPosition =   3  'Windows Default
   Begin GISATTEDITLib.GisAttEdit GisAttEdit 
      Height          =   855
      Left            =   3000
      TabIndex        =   1
      Top             =   1920
      Width           =   1095
      _Version        =   65536
      _ExtentX        =   1931
      _ExtentY        =   1508
      _StockProps     =   0
      EditEnable      =   1
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1200
      Top             =   2400
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "点文件(*.wt)|*.wt|线文件(*.wl)|*.wl"
      FilterIndex     =   1
   End
   Begin ATTSTRUEDITLib.AttStruEdit AttStruEdit1 
      Height          =   495
      Left            =   2880
      TabIndex        =   0
      Top             =   840
      Width           =   1695
      _Version        =   65536
      _ExtentX        =   2990
      _ExtentY        =   873
      _StockProps     =   0
      EditEnable      =   1
   End
   Begin VB.Menu ATT_STRU 
      Caption         =   "属性结构"
      Begin VB.Menu GetAttStru 
         Caption         =   "取属性结构"
      End
      Begin VB.Menu APPENDFLD 
         Caption         =   "添加字段"
      End
      Begin VB.Menu IDMN_STRU_DEL 
         Caption         =   "删除字段"
      End
      Begin VB.Menu IDMN_STRU_MOD 
         Caption         =   "修改字段"
      End
   End
   Begin VB.Menu ATT 
      Caption         =   "属性"
      Begin VB.Menu GATATT 
         Caption         =   "取属性"
      End
      Begin VB.Menu WRITEATT 
         Caption         =   "写一条属性记录"
      End
   End
End
Attribute VB_Name = "AttOper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'============================================================================================================
'主要功能:
'         本例主要演示了AttStruEdit以及GisAttEdit两个控件的使用方法以及工作区属性和属性结构的读取,修改,写入等操作.
'使用到的主要控件:
'         AttStruEdit  ,  GisAttEdit
        
'============================================================================================================
Option Explicit


Private Sub Form_Load()
AttStruEdit1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight / 2
GisAttEdit.Move 0, AttStruEdit1.Height, Me.ScaleWidth, Me.ScaleHeight / 2


End Sub

'取属性结构信息(包括字段总数，
'每一个字段的字段名称，字段类型，
'字段字符长度,字段序号,小数位数)
Private Sub GetAttStru_Click()

Dim pntObj As PntArea
Dim linobj As LinArea

Dim fldNum As Integer       '字段数
Dim rcdNum As Long          '纪录数

Dim fldname As String       '字段名称
Dim fldtype As Integer      '字段类型
Dim msk_leng As Long        '字段字符长度
Dim ptc_pos As Integer      '字段序号
Dim point_leng As Integer   '小数位数

Dim i As Integer
Dim str As String
Dim n As Long

CommonDialog1.ShowOpen
str = CommonDialog1.FileName
n = CommonDialog1.FilterIndex

Select Case n

Case 1

Set pntObj = New PntArea
If (pntObj.Load(str)) Then
    
    fldNum = pntObj.ATT.stru.numbfield

    
    For i = 0 To pntObj.ATT.stru.numbfield - 1
        fldname = pntObj.ATT.stru(i).fieldname
        fldtype = pntObj.ATT.stru(i).fieldtype
        msk_leng = pntObj.ATT.stru(i).msk_leng
        point_leng = pntObj.ATT.stru(i).point_leng
        ptc_pos = pntObj.ATT.stru(i).ptc_pos
    Next i
  AttStruEdit1.AttachArea pntObj, 1
End If

Case 2

Set linobj = New LinArea
If (linobj.Load(str)) Then
    
    fldNum = linobj.ATT.stru.numbfield

    
    For i = 0 To linobj.ATT.stru.numbfield - 1
        fldname = linobj.ATT.stru(i).fieldname
        fldtype = linobj.ATT.stru(i).fieldtype
        msk_leng = linobj.ATT.stru(i).msk_leng
        point_leng = linobj.ATT.stru(i).point_leng
        ptc_pos = linobj.ATT.stru(i).ptc_pos
    Next i
  AttStruEdit1.AttachArea linobj, 0
End If

End Select


 
Set pntObj = Nothing
Set linobj = Nothing



End Sub

'添加字段
Private Sub APPENDFLD_Click()
Dim pntObj As PntArea
Dim linobj As LinArea
Dim regObj As RegArea
Dim fldinf As Field_Head
Dim mystru As Record_Head
Dim flag As Boolean
Dim str As String
Dim n As Long

CommonDialog1.ShowOpen
str = CommonDialog1.FileName
n = CommonDialog1.FilterIndex

Select Case n

Case 1
Set pntObj = New PntArea
If (pntObj.Load(str)) Then

'构造需添加的字段信息
    Set fldinf = New Field_Head
    fldinf.fieldname = "newflddouble"
    fldinf.fieldtype = gisDOUBLE_TYPE
    fldinf.point_leng = 0.3
    fldinf.msk_leng = 10
    fldinf.edit_enable = 1
    fldinf.ptc_pos = -1
'方法1 ...添加字段
    flag = pntObj.ATT.stru.AppendField(fldinf)
'    fldinf.fieldname = "newfldstr"
'    fldinf.fieldtype = gisSTR_TYPE
'    fldinf.msk_leng = 32
'    fldinf.edit_enable = 1
'    fldinf.ptc_pos = -1
'    flag = pntObj.Att.stru.AppendField(fldinf)
'方法2：...添加字段
'    Set mystru = pntObj.Att.stru.Clone()
'    flag = mystru.AppendField(fldinf)
'    flag = pntObj.Att.stru.Set(mystru)
'    Set mystru = Nothing
    
    Set fldinf = Nothing

End If

pntObj.Save
AttStruEdit1.AttachArea pntObj, 1

Case 2

Set linobj = New LinArea
If (linobj.Load(str)) Then

'构造需添加的字段信息
    Set fldinf = New Field_Head
    fldinf.fieldname = "newflddouble"
    fldinf.fieldtype = gisDOUBLE_TYPE
    fldinf.point_leng = 0.3
    fldinf.msk_leng = 10
    fldinf.edit_enable = 1
    fldinf.ptc_pos = -1
'方法1 ...添加字段
    flag = linobj.ATT.stru.AppendField(fldinf)
'    fldinf.fieldname = "newfldstr"
'    fldinf.fieldtype = gisSTR_TYPE
'    fldinf.msk_leng = 32
'    fldinf.edit_enable = 1
'    fldinf.ptc_pos = -1
'    flag = pntObj.Att.stru.AppendField(fldinf)
'方法2：...添加字段
'    Set mystru = pntObj.Att.stru.Clone()
'    flag = mystru.AppendField(fldinf)
'    flag = pntObj.Att.stru.Set(mystru)
'    Set mystru = Nothing
    
    Set fldinf = Nothing

End If

linobj.Save
AttStruEdit1.AttachArea linobj, 0

End Select

Set pntObj = Nothing
Set linobj = Nothing


End Sub
'删除字段
Private Sub IDMN_STRU_DEL_Click()

Dim pntObj As PntArea
Dim fldinf As Field_Head
Dim mystru As Record_Head
Dim flag As Boolean
Dim i As Long

Set pntObj = New PntArea
If (pntObj.Load()) Then
    
    '方法1：根据字段名称删除字段
    'flag = pntObj.ATT.stru.DelField("mystr")
    
    '方法2: 根据字段序号删除字段
    flag = pntObj.ATT.stru.DelField2(1)
    
    '循环删除字段
'    If (pntObj.ATT.stru.numbfield >= 1) Then
'        For i = pntObj.ATT.stru.numbfield - 1 To 0 Step -1
'            flag = pntObj.ATT.stru.DelField2(i)
'        Next i
'    End If
    
End If
AttStruEdit1.AttachArea pntObj, 1
Set pntObj = Nothing

End Sub
'修改字段 (字段名称，字段类型等等）
Private Sub IDMN_STRU_MOD_Click()
Dim pntObj As PntArea
Dim mystru As Record_Head
Dim myfld As Field_Head
Dim flag As Boolean

Set pntObj = New PntArea
If (pntObj.Load()) Then
   Set mystru = pntObj.ATT.stru.Clone()
   Set myfld = mystru(1)
   
   myfld.fieldname = "myddd"
   myfld.fieldtype = gisDOUBLE_TYPE
   myfld.point_leng = 3
   myfld.msk_leng = 15
   mystru(1) = myfld
   
   flag = pntObj.ATT.stru.Set(mystru)
   
   pntObj.Save

End If
AttStruEdit1.AttachArea pntObj, 1
Set pntObj = Nothing
End Sub
'取属性
Private Sub GATATT_Click()
Dim pntObj As PntArea
Dim linobj As LinArea
Dim i, j As Long
Dim val As Variant
Dim att2 As New Record
Dim flag As Integer
Dim str As String
Dim n As Long

CommonDialog1.ShowOpen
str = CommonDialog1.FileName
n = CommonDialog1.FilterIndex

Select Case n

Case 1
Set pntObj = New PntArea
If (pntObj.Load(str)) Then
    For i = 1 To pntObj.Count
        flag = pntObj.ATT.Get(1, att2)
        For j = 0 To pntObj.ATT.stru.numbfield - 1
            
            val = att2.Item(1).Value
        Next j
        Set att2 = Nothing
    Next i
End If
GisAttEdit.AttachArea pntObj, gisPNT_ENTITY

Case 2
Set linobj = New LinArea
If (linobj.Load(str)) Then
    For i = 1 To linobj.Count
        flag = linobj.ATT.Get(1, att2)
        For j = 0 To linobj.ATT.stru.numbfield - 1
            
            val = att2.Item(1).Value
        Next j
        Set att2 = Nothing
    Next i
End If
GisAttEdit.AttachArea linobj, gisLIN_ENTITY

End Select
Set pntObj = Nothing
Set linobj = Nothing



End Sub

'写属性纪录
Private Sub WRITEATT_Click()
Dim TblAi As TblArea
Dim i, j As Long
Dim val As Variant
Dim ATT As Record
Dim flag As Boolean
Dim byteval(9) As Byte
Dim variantval(9)
Dim aType As Enum_Field_Type


'写点属性id值,如下写一条属性记录：
Set TblAi = New TblArea
If (TblAi.Load()) Then
    '取一条纪录
    flag = TblAi.Get(1, ATT)
    If Not flag Then
     GoTo EndWrite
    End If
    
    For i = 0 To TblAi.stru.numbfield - 1
        aType = ATT.Item(i).FieldHD.fieldtype
    Select Case aType
    Case gisBIN_DATA_TYPE
        For j = 0 To 9                 '写二进制值
           byteval(j) = 10 + j
        Next j
        ATT.Value(i) = byteval
    '此处还可以根据字段名来赋值，如：
    'att.Value("ID") =byteval
    Case gisBOOL_TYPE       '布尔型
        ATT.Value(i) = True '或者0/1
    Case gisBYTE_TYPE       '字节型
        ATT.Value(i) = 1
    Case gisDATE_TYPE       '日期型
        ATT.Value(i) = "2000-1-20"
    Case gisDOUBLE_TYPE     '双精度型
        ATT.Value(i) = 10.0567
    Case gisFLOAT_TYPE      '浮点型
        ATT.Value(i) = 4.5
    Case gisLONG_TYPE       '长整型
        ATT.Value(i) = 43425345
    Case gisNUMBERIC_TYPE   '数字型
        ATT.Value(i) = 43.42
    Case gisSHORT_TYPE      '短整型
        ATT.Value(i) = 4
    Case gisSTR_TYPE        '字符串
        ATT.Value(i) = "字符串"
    Case gisTIME_TYPE       '时间型
        ATT.Value(i) = "20:17:50"
    Case gisTIMESTAMP_TYPE  '邮戳型
        ATT.Value(i) = "2000-10-10 22:15:36"
    Case gisMAP_TYPE        '地图型
    
    Case gisPICTURE_TYPE    '图象型
    
    Case gisSOUND_TYPE      '声音型
    
    Case gisTABLE_TYPE      '表格数据
    
    Case gisTEXT_TYPE       '文本型
                                                             
    Case gisEXT_TYPE        '扩展型
            
    Case gisVIDEO_TYPE      '视频图象型
    
    Case gisUNKNOWN_TYPE    '未知类型
        MsgBox "未知类型！"
    End Select
    Next i
End If
GisAttEdit.AttachArea TblAi, gisTBL_ENTITY
        
'写第一条属性记录
flag = TblAi.Write(1, ATT)

EndWrite:
Set ATT = Nothing
Set TblAi = Nothing
End Sub