?? basdemo.frm
字號(hào):
VERSION 5.00
Begin VB.Form BasObj
Caption = "基本對(duì)象"
ClientHeight = 3195
ClientLeft = 165
ClientTop = 450
ClientWidth = 4680
Icon = "BasDemo.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleLeft = 1000
ScaleMode = 0 'User
ScaleTop = 1000
ScaleWidth = 4680
Begin VB.Menu MapGisObject
Caption = "MapGis全局對(duì)象"
Begin VB.Menu MapGisAbout
Caption = "版本信息"
End
Begin VB.Menu ClockAndCursor
Caption = "走鐘與光標(biāo)"
End
Begin VB.Menu GetFileInfo
Caption = "取文件信息"
End
Begin VB.Menu DefParamOper
Caption = "缺省參數(shù)操作"
End
Begin VB.Menu CompMapParam
Caption = "比較圖形參數(shù)"
End
Begin VB.Menu EditMapParam
Caption = "編輯圖形參數(shù)"
End
Begin VB.Menu NetDataSource
Caption = "網(wǎng)絡(luò)數(shù)據(jù)源操作"
End
Begin VB.Menu SelectShow
Caption = "公共對(duì)話框函數(shù)"
End
Begin VB.Menu CalLinLenAndDot
Caption = "計(jì)算線段長(zhǎng)度交點(diǎn)"
End
Begin VB.Menu ReplaceParam
Caption = "修改參數(shù)替換條件結(jié)果"
End
End
Begin VB.Menu OtherObject
Caption = "其它相關(guān)對(duì)象"
Begin VB.Menu SetRelateObject
Caption = "集合相關(guān)對(duì)象"
End
Begin VB.Menu AttRelateObject
Caption = "屬性相關(guān)對(duì)象"
End
End
End
Attribute VB_Name = "BasObj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'==========================================================================================================
'主要功能:
' 本例主要演示了MapGis的一些全局對(duì)象的調(diào)用方法,包括公共對(duì)話框等.
'
'==========================================================================================================
Option Explicit
Dim bRes As Boolean
Dim nRes As Integer
Dim lRes As Long
Private Sub AttRelateObject_Click()
'關(guān)于擴(kuò)展屬性結(jié)構(gòu),屬性結(jié)構(gòu),屬性,記錄等的使用
Dim val As Variant
'--------------------------------------------
'Field_ExtHead的使用
'--------------------------------------------
Dim objFieldExtHead As Field_ExtHead
Dim bResult As Boolean
Dim nResult As Integer
Dim ttlStr As String
'創(chuàng)建一個(gè)Field_ExtHead實(shí)例
Set objFieldExtHead = New Field_ExtHead
'使用時(shí)一定要先初始化擴(kuò)展字段
bResult = objFieldExtHead.Init(gisDATE_TYPE, 2)
If Not bResult Then
MsgBox "初始化擴(kuò)展字段失敗!"
Exit Sub
End If
'設(shè)置字段別名
objFieldExtHead.alias = "字段為日期類型"
'允許為空
objFieldExtHead.IsNull = True
'設(shè)置字段形態(tài),可為編輯框/組合框/復(fù)選框/按扭
objFieldExtHead.Shape = gisFLD_SHP_COMBO
'數(shù)值型,日期,時(shí)間,郵戳類型可有缺省值和最大最小值
'設(shè)置缺省值
objFieldExtHead.SetDefVal ("1-1-1990")
'設(shè)置最大值
objFieldExtHead.SetMaxVal ("12-12-1999")
'設(shè)置最小值
objFieldExtHead.SetMinVal ("12-30-1990")
'設(shè)置字段形態(tài)信息,此處省略返回值處理
bResult = objFieldExtHead.SetShapeInfo(0, "字段形態(tài)0", "3-4-1977")
bResult = objFieldExtHead.SetShapeInfo(1, "字段形態(tài)1", "4-5-1987")
'是否有缺省值
If objFieldExtHead.HasDefVal Then
'取缺省值
objFieldExtHead.GetDefVal val
'打印顯示值
MsgBox val
End If
'是否有最大值
If objFieldExtHead.HasMaxVal Then
'取最大值
objFieldExtHead.GetMaxVal val
MsgBox val
End If
'是否有最小值
If objFieldExtHead.HasMinVal Then
'取最小值
objFieldExtHead.GetMinVal val
MsgBox val
End If
'取字段類型,顯示
MsgBox objFieldExtHead.GetFieldType
'顯示字段形態(tài)信息
For nResult = 1 To objFieldExtHead.GetShapeInfoNum
'取字段形態(tài)信息
bResult = objFieldExtHead.GetShapeInfo(nResult - 1, ttlStr, val)
If bResult Then
MsgBox ttlStr & ": " & val
Else: Exit For
End If
Next nResult
'--------------------------------------------
'Field_Head的使用
'--------------------------------------------
'創(chuàng)建Field_Head對(duì)象實(shí)例
Dim objFieldHead1 As New Field_Head
Dim objFieldHead2 As New Field_Head
Dim buf() As Byte
With objFieldHead1
'編輯使能標(biāo)志(0/1/2=不能/能/禁止)
.edit_enable = 1
'字段名稱
.fieldname = "字段1"
'字段類型
.fieldtype = gisDOUBLE_TYPE
'字段字符長(zhǎng)度
.msk_leng = 8
'小數(shù)位數(shù)
.point_leng = 4
'字段序號(hào),依次為0,1,2...
.ptc_pos = 0
End With
With objFieldHead2
.edit_enable = 1
.fieldname = "字段2"
.fieldtype = gisSTR_TYPE
.msk_leng = 16
.point_leng = 0
.ptc_pos = 1
End With
'判斷是否相等
If objFieldHead1.IsEqual(objFieldHead2) Then
MsgBox "兩對(duì)象實(shí)例相等"
End If
Set objFieldHead2 = Nothing
'克隆出一個(gè)新的Field_Head
Set objFieldHead2 = objFieldHead1.Clone
'計(jì)算FIELD_HEAD對(duì)象所占的字節(jié)數(shù)
val = objFieldHead1.CalSize
' 保存CFiedl_Head到buf中
ReDim buf(255)
objFieldHead1.Save buf(0), val
'從buf中裝入IField_Head
'判斷是否有擴(kuò)展屬性
If Not objFieldHead1.HasField_ExtHead Then
'設(shè)置擴(kuò)展屬性
If objFieldHead1.SetField_ExtHead(objFieldExtHead) Then
Set objFieldExtHead = Nothing
'取字段擴(kuò)展屬性
Set objFieldExtHead = objFieldHead1.GetField_ExtHead
End If
End If
'刪除擴(kuò)展字段
If objFieldHead1.DelField_ExtHead Then
MsgBox "擴(kuò)展字段已刪除"
End If
'從buf中裝入IField_Head
'If objFieldHead1.Load(buf, Val) Then
' msgbox "原Field_Head對(duì)象內(nèi)容已裝入"
' End If
'復(fù)制，ptIFld0=NULL則清除
Set objFieldHead2 = Nothing
objFieldHead2.Set objFieldHead1
'--------------------------------------------
'Record_Head的使用
'--------------------------------------------
Dim objRecordHead As New Record_Head
Dim objRecordHead1 As Record_Head
Dim nCount As Integer
'分配空字段,此處為2個(gè)
objRecordHead.AllocEmptyField 2
With objFieldHead1
'編輯使能標(biāo)志(0/1/2=不能/能/禁止)
.edit_enable = 1
'字段名稱
.fieldname = "字段1"
'字段類型
.fieldtype = gisDOUBLE_TYPE
'字段字符長(zhǎng)度
.msk_leng = 8
'小數(shù)位數(shù)
.point_leng = 4
'字段序號(hào),依次為0,1,2...
.ptc_pos = 0
End With
'添加字段,省略返回值
objRecordHead.AppendField objFieldHead1
With objFieldHead2
.edit_enable = 1
.fieldname = "字段2"
.fieldtype = gisSTR_TYPE
.msk_leng = 32
.point_leng = 0
.ptc_pos = 1
End With
bResult = objRecordHead.InsertField(objFieldHead2, 0)
If Not bResult Then
MsgBox "插入失敗"
End If
'克隆一個(gè)新的Record_Head
Set objRecordHead1 = objRecordHead.Clone
'比較相同
If objRecordHead.IsEqual(objRecordHead1) Then
MsgBox "屬性結(jié)構(gòu)完全相同"
End If
'依次打印屬性結(jié)構(gòu)中的各字段名
For nCount = 0 To objRecordHead.numbfield - 1
MsgBox objRecordHead.fldEntry(nCount).fieldname
Next nCount
'計(jì)算Record_Head對(duì)象占用存儲(chǔ)空間大小
MsgBox "Record_Head1對(duì)象占用存儲(chǔ)空間大小為：" & _
objRecordHead.CalSize
'保存Record_Head到buf中
ReDim buf(255)
lRes = objRecordHead.Save(buf(0), 256)
'從buf中裝入Record_Head
objRecordHead.Load buf(0), lRes
'刪除字段(方法一)
objRecordHead.DelField "字段2"
'刪除字段(方法二)
objRecordHead.DelField 0
'復(fù)制，pIStru0=NULL則清除所有字段頭
objRecordHead.Set objRecordHead1
'--------------------------------------------
'Field的使用
'--------------------------------------------
Dim objField As New Field
Dim objField1 As New Field
Dim objRecord As New Record
Dim objRecord1 As New Record
'設(shè)置字段描述頭
objField.FieldHD = objFieldHead1
'字段值,需要同字段描述頭的類型相同
objField.Value = -342.12
'字段值的真實(shí)字節(jié)長(zhǎng)度
MsgBox objField.ActualSize
'設(shè)置字段描述頭
objField1.FieldHD = objFieldHead2
'字段值,需要同字段描述頭的類型相同
objField1.Value = "這是字段值"
'字段值的真實(shí)字節(jié)長(zhǎng)度
'--------------------------------------------
'Record的使用
'--------------------------------------------
'設(shè)置屬性結(jié)構(gòu)
Set objRecord = New Record
'添加字段,省略返回值
objRecord.Append objField
'在index位置插入一個(gè)字段,省略返回值
objRecord.Insert 0, objField1
'分別取記錄里的字段名，字段值，并顯示
For nCount = 0 To objRecord.Count - 1
MsgBox objRecord.Item(nCount).FieldHD.fieldname & _
":" & objRecord.Value(nCount)
Next nCount
'復(fù)制記錄
objRecord1.Set objRecord
'刪除記錄中的字段,省略返回值
objRecord1.Remove 1
'--------------------------------------------
'RecordSet的使用
'--------------------------------------------
Dim objRecordSet As New Recordset
'添加一條記錄，此處只有兩個(gè)字段
objRecordSet.Append objRecord
'以下再添加兩條記錄
objRecord.Value(0) = 235.3
objRecord.Value(1) = "第二記錄對(duì)應(yīng)值"
objRecordSet.Append objRecord
objRecord.Value(0) = 235.3
objRecord.Value(1) = "第三記錄對(duì)應(yīng)值"
objRecordSet.Append objRecord
'書(shū)簽,相當(dāng)于RecordSet中記錄的序號(hào),第1條記錄從1開(kāi)始
'設(shè)置當(dāng)前位置為第一條記錄
objRecordSet.Bookmark = 1
'更新第一條記錄
objRecord.Value(0) = 567.12
objRecord.Value(1) = "更新為第一記錄對(duì)應(yīng)值"
objRecordSet.Update objRecord
'將當(dāng)前指針移到最后一條記錄
objRecordSet.MoveLast
'當(dāng)前記錄位置是否在RecordSet中的第一條記錄之前
While Not objRecordSet.BOF
'將當(dāng)前指針前移一條記錄,省略返回值
objRecordSet.MovePrevious
Wend
'以下依次在“立即”窗口中顯示各條記錄值
'將當(dāng)前指針移到第一條記錄,省略返回值
objRecordSet.MoveFirst
Do
For nCount = 0 To objRecordSet.numbfield - 1
MsgBox objRecordSet.hd(nCount).fieldname & _
"------" & objRecordSet.Record.Value(nCount)
Next nCount
'將當(dāng)前指針后移一條記錄
If Not objRecordSet.MoveNext Then
Exit Do
End If
'直到當(dāng)前記錄位置在RecordSet中的最后一條記錄之后
Loop While objRecordSet.EOF
'從start指定的位置開(kāi)始移numRecords條記錄
If objRecordSet.Move(1, gisBookmarkFirst) Then
'刪除當(dāng)前位置記錄
objRecordSet.Remove
End If
'釋放對(duì)象實(shí)例
Set objField = Nothing
Set objField1 = Nothing
Set objRecord = Nothing
Set objRecord1 = Nothing
Set objRecordSet = Nothing
Set objFieldHead1 = Nothing
Set objFieldHead2 = Nothing
Set objRecordHead = Nothing
Set objRecordHead1 = Nothing
Set objFieldExtHead = Nothing
End Sub
Private Sub CalLinLenAndDot_Click()
Dim la0 As New D_Dot '直線1
Dim la1 As New D_Dot
Dim lb0 As New D_Dot '直線2
Dim lb1 As New D_Dot
Dim xy As D_Dot '交點(diǎn)
Dim length As Double '長(zhǎng)度
Dim DotSet As D_DotSet
'計(jì)算兩直線段的交點(diǎn)
la0.x = 50
la0.y = 100
la1.x = 150
la1.y = 100
lb0.x = 100
lb0.y = 50
lb1.x = 100
lb1.y = 150
'計(jì)算交點(diǎn)
bRes = CalCrossDot(la0, la1, lb0, lb1, xy)
If bRes Then
MsgBox "交點(diǎn)坐標(biāo)為:" & xy.x & "," & xy.y
End If
'計(jì)算線段長(zhǎng)度 (方法一)
length = SegmentLength(la0, la1)
MsgBox "線段長(zhǎng)度為：" & length
'計(jì)算線段長(zhǎng)度 (方法二)
length = SegmentLength1(100, 50, 100, 150)
MsgBox "線段長(zhǎng)度為：" & length
'計(jì)算線段長(zhǎng)度 (方法三)
Set DotSet = New D_DotSet
DotSet.Append2 la0
DotSet.Append2 la1
length = CalculateLength(DotSet)
MsgBox "線段長(zhǎng)度為：" & length
Set xy = Nothing
Set la0 = Nothing
Set la1 = Nothing
Set lb0 = Nothing
Set lb1 = Nothing
Set DotSet = Nothing
End Sub
Private Sub ClockAndCursor_Click()
Dim i, j, k As Long
'走鐘與光標(biāo)適合長(zhǎng)時(shí)間等待時(shí)的操作
'開(kāi)始顯示等待光標(biāo)
StartWait
'開(kāi)始時(shí)鐘光標(biāo)
StartClockCursor
For i = 1 To 100
For j = 1 To 100
For k = 1 To 10
'開(kāi)始走鐘
GoingClockCursor
Next k
Next j
Next i
'還原光標(biāo)
EndClockCursor
'結(jié)束顯示等待光標(biāo)
EndWait
End Sub
Private Sub CompMapParam_Click()
Dim PntAi As PntArea
Dim inf0 As Pnt_Info
Dim inf1 As Pnt_Info
Dim pad As Pnt_Pad
'根據(jù)pad條件比較圖形參數(shù)inf0和inf1是否相同
'比較點(diǎn)參數(shù)
Set PntAi = New PntArea
If Not PntAi.Load Then
Set PntAi = Nothing
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -