?? frmcreatebuffer.frm
字號(hào):
VERSION 5.00
Begin VB.Form frmCreateBuffer
Caption = "生成緩沖區(qū)"
ClientHeight = 2820
ClientLeft = 60
ClientTop = 450
ClientWidth = 4425
LinkTopic = "Form1"
ScaleHeight = 2820
ScaleWidth = 4425
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 375
Left = 2640
TabIndex = 7
Top = 2160
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "確定"
Height = 375
Left = 720
TabIndex = 6
Top = 2160
Width = 1215
End
Begin VB.CommandButton cmdLayers
Caption = "..."
Height = 375
Left = 3720
TabIndex = 5
Top = 1320
Width = 495
End
Begin VB.TextBox txtLayers
Height = 375
Left = 1920
TabIndex = 4
Text = "Temp"
Top = 1320
Width = 1575
End
Begin VB.ComboBox cboUnit
Height = 300
Left = 3120
TabIndex = 3
Top = 630
Width = 1095
End
Begin VB.TextBox txtDistance
Height = 375
Left = 1920
TabIndex = 2
Top = 600
Width = 975
End
Begin VB.Label Label3
Caption = "緩沖區(qū)圖層:"
Height = 375
Left = 480
TabIndex = 1
Top = 1440
Width = 1215
End
Begin VB.Label Label2
Caption = "緩沖區(qū)距離:"
Height = 375
Left = 480
TabIndex = 0
Top = 720
Width = 1215
End
End
Attribute VB_Name = "FrmCreateBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim oLayer As MapXLib.Layer
Dim FileName As String
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdLayers_Click()
Call AddLayer
End Sub
Private Sub cmdok_Click()
Dim BufferFea As MapXLib.Feature
Dim FTRS As MapXLib.Features
Dim FeaFac As FeatureFactory
Dim Fea As MapXLib.Feature
Dim Ftr As MapXLib.Feature
Dim Lyr As MapXLib.Layer
Dim TempLyr As MapXLib.Layer
Dim SelectionUnit As Integer
Dim i As Integer
If txtDistance.Text = "" Then
MsgBox "請(qǐng)輸入距離", vbInformation
Exit Sub
End If
If txtLayers.Text = "Temp" Then
For i = 1 To frmMain.MapDisp.Layers.Count
If frmMain.MapDisp.Layers(i).Name = "Temporary Layer" Then
Set TempLyr = frmMain.MapDisp.Layers.Item("Temporary Layer")
GoTo AddBuffer
End If
Next
frmMain.CreateTempLayer
Set TempLyr = frmMain.MapDisp.Layers.Item("Temporary Layer")
Else
Set TempLyr = frmMain.MapDisp.Layers.Item(FileName)
End If
AddBuffer:
Set FeaFac = frmMain.MapDisp.FeatureFactory
SelectionUnit = IdentifyUnits
For Each Lyr In frmMain.MapDisp.Layers
If Lyr.Selection.Count <> 0 Then
Set FTRS = Lyr.Selection.Clone
Set Ftr = FeaFac.CombineFeatures(FTRS)
For Each Fea In FTRS
Set BufferFea = FeaFac.BufferFeatures(Ftr, Val(txtDistance.Text), SelectionUnit)
TempLyr.AddFeature BufferFea
Next
End If
Next
Unload Me
End Sub
Private Sub Form_Load()
cboUnit.AddItem "Mile"
cboUnit.AddItem "Kilometer"
cboUnit.AddItem "Inch"
cboUnit.AddItem "Foot"
cboUnit.AddItem "Yard"
cboUnit.AddItem "Millimeter"
cboUnit.AddItem "Centimeter"
cboUnit.AddItem "Meter"
cboUnit.AddItem "SurveyFoot"
cboUnit.AddItem "NauticalMile"
cboUnit.AddItem "Twip"
cboUnit.AddItem "Point"
cboUnit.AddItem "Pica"
cboUnit.AddItem "Degree"
cboUnit.AddItem "Link"
cboUnit.AddItem "Chain"
cboUnit.AddItem "Rod"
cboUnit.ListIndex = 7
End Sub
Private Function IdentifyUnits() As Integer
Dim Unit As Integer
Select Case cboUnit.ListIndex
Case 0 ' Miles
Unit = miUnitMile
Case 1 ' Kilometers
Unit = miUnitKilometer
Case 2 ' Inches
Unit = miUnitInch
Case 3 ' Feet
Unit = miUnitFoot
Case 4 ' Yards
Unit = miUnitYard
Case 5 ' Millimeters
Unit = miUnitMillimeter
Case 6 ' Centimeters
Unit = miUnitCentimeter
Case 7 ' Meters
Unit = miUnitMeter
Case 8 ' Survey Feet
Unit = miUnitSurveyFoot
Case 9 ' Nautical Miles
Unit = miUnitNauticalMile
Case 10 ' Twips
Unit = miUnitTwip
Case 11 ' Points
Unit = miUnitPoint
Case 12 ' Picas
Unit = miUnitPica
Case 13 ' Degrees
Unit = miUnitDegree
Case 14 ' Links
Unit = miUnitLink
Case 15 ' Chains
Unit = miUnitChain
Case 16 ' Rods
Unit = miUnitRod
End Select
IdentifyUnits = Unit
End Function
Function AddLayer()
With frmMain.cdlTest
.DialogTitle = "保存圖層"
.CancelError = True
.FileName = ""
.Filter = "mapinfo table(*.tab)|*.tab"
.ShowSave
If Len(.FileName) = 0 Then
MsgBox "請(qǐng)選擇圖層!"
End If
End With
Me.txtLayers.Text = frmMain.cdlTest.FileTitle
FileName = Left(frmMain.cdlTest.FileTitle, Len(frmMain.cdlTest.FileTitle) - 4)
End Function
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -