?? analysis.frm

?? 用vb進行MAPGIS二次開發的示例可以用以在進行MAPGIS二次開發的參考
?? FRM
?? 第 1 頁 / 共 2 頁
字號:
12 下一頁
VERSION 5.00
Object = "{5A187E03-1FE4-11D3-9C2F-000021DF30C1}#1.0#0"; "EditView.ocx"
Begin VB.Form TAnalysis 
   Caption         =   "空間分析"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   4680
   Icon            =   "Analysis.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   Begin EDITVIEWLib.EditView EditView 
      Height          =   3012
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4572
      _Version        =   65536
      _ExtentX        =   8064
      _ExtentY        =   5313
      _StockProps     =   0
   End
   Begin VB.Menu VectorAnalysis 
      Caption         =   "矢量疊加分析"
      Begin VB.Menu RegToReg 
         Caption         =   "區對區"
      End
      Begin VB.Menu LinToReg 
         Caption         =   "線對區"
      End
      Begin VB.Menu PntToReg 
         Caption         =   "點對區"
      End
      Begin VB.Menu PntToLin 
         Caption         =   "點對線"
      End
      Begin VB.Menu RegToPnt 
         Caption         =   "區對點"
      End
   End
   Begin VB.Menu ClipAnalysis 
      Caption         =   "裁剪分析"
      Begin VB.Menu ClipP 
         Caption         =   "裁剪點"
      End
      Begin VB.Menu ClipL 
         Caption         =   "裁剪線"
      End
      Begin VB.Menu ClipR 
         Caption         =   "裁剪區"
      End
      Begin VB.Menu ClipG 
         Caption         =   "裁剪圖形"
      End
   End
   Begin VB.Menu BufferAnalysis 
      Caption         =   "緩沖區分析"
      Begin VB.Menu oneLinBuf 
         Caption         =   "一條線"
      End
      Begin VB.Menu OnePntBuf 
         Caption         =   "一個點"
      End
      Begin VB.Menu OneRegBuf 
         Caption         =   "一個區"
      End
      Begin VB.Menu TolLinBuf 
         Caption         =   "全部線"
      End
      Begin VB.Menu TolPntBuf 
         Caption         =   "全部點"
      End
      Begin VB.Menu TolRegBuf 
         Caption         =   "全部區"
      End
      Begin VB.Menu ListLin 
         Caption         =   "線可變半徑"
      End
      Begin VB.Menu ListPnt 
         Caption         =   "點可變半徑"
      End
      Begin VB.Menu ListReg 
         Caption         =   "區可變半徑"
      End
   End
End
Attribute VB_Name = "TAnalysis"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
 Dim objAnalysis As Analysis
 
Private Sub ClipG_Click()
'...................裁剪圖形.........................
Dim objLinArea0 As LinArea
Dim objRegArea1 As RegArea
Dim objRegArea2 As RegArea
Dim radiu As Double
Dim Op As Enum_Clip_Type
Dim rtl As Boolean

Set objLinArea0 = New LinArea '裁剪框工作區對象
Set objRegArea1 = New RegArea '被裁剪工作區對象
Set objRegArea2 = New RegArea '結果工作區對象
objLinArea0.Load '裝入裁剪框工作區
objRegArea1.Load '裝入被裁剪工作區
radiu = 0.0598 '模糊半徑
Op = gisOVLY_INCLIP '裁剪類型-內
rtl = objAnalysis.ClipRegGraph(objLinArea0, objRegArea1, objRegArea2, radiu, Op)

If rtl Then
    MsgBox "裁剪成功"
Else
    MsgBox "裁剪失敗"
End If

Set objLinArea0 = Nothing
Set objRegArea1 = Nothing
Set objRegArea2 = Nothing

End Sub

Private Sub ClipL_Click()
'...................裁剪線.........................
Dim objLinArea0 As LinArea
Dim objLinArea1 As LinArea
Dim objLinArea2 As LinArea
Dim radiu As Double
Dim Op As Enum_Clip_Type
Dim rtl As Boolean

Set objLinArea0 = New LinArea '裁剪框工作區對象
Set objLinArea1 = New LinArea '被裁剪工作區對象
Set objLinArea2 = New LinArea '結果工作區對象
objLinArea0.Load '裝入裁剪框工作區
objLinArea1.Load '裝入被裁剪工作區
radiu = 0.0598 '模糊半徑
Op = gisOVLY_INCLIP '裁剪類型-內
rtl = objAnalysis.ClipLin(objLinArea0, objLinArea1, objLinArea1, radiu, Op)

'objLinArea2.Save "3333.wl"

If rtl Then
    MsgBox "裁剪成功"
Else
    MsgBox "裁剪失敗"
End If

EditView.LinArea = objLinArea2
Set objLinArea0 = Nothing
Set objLinArea1 = Nothing
Set objLinArea2 = Nothing

End Sub

Private Sub ClipP_Click()
'...................裁剪點.........................
Dim objLinArea0 As LinArea
Dim objPntArea1 As PntArea
Dim objPntArea2 As PntArea
Dim radiu As Double
'Dim op As Enum_Clip_Type
Dim Op(2) As Enum_Clip_Type
Dim rtl As Boolean

Set objLinArea0 = New LinArea '裁剪框工作區對象
Set objPntArea1 = New PntArea '被裁剪工作區對象
Set objPntArea2 = New PntArea '結果工作區對象
objLinArea0.Load '裝入裁剪框工作區
objPntArea1.Load '裝入被裁剪工作區
radiu = 0.0598 '模糊半徑
'Op = gisOVLY_INCLIP  '裁剪類型-內
Op(0) = gisOVLY_INCLIP '裁剪類型-內
Op(1) = gisOVLY_OUTCLIP '裁剪類型-外
rtl = objAnalysis.ClipPnt(objLinArea0, objPntArea1, objPntArea2, radiu, Op(0))

If rtl Then
    MsgBox "裁剪成功"
Else
    MsgBox "裁剪失敗"
End If
EditView.PntArea = objPntArea2
EditView.RestoreWindow
Set objLinArea0 = Nothing
Set objPntArea1 = Nothing
Set objPntArea2 = Nothing

End Sub

Private Sub ClipR_Click()
'...................裁剪區.........................
Dim objLinArea0 As LinArea
Dim objRegArea1 As RegArea
Dim objRegArea2 As RegArea
Dim radiu As Double
Dim Op As Enum_Clip_Type
Dim rtl As Boolean

Set objLinArea0 = New LinArea '裁剪框工作區對象
Set objRegArea1 = New RegArea '被裁剪工作區對象
Set objRegArea2 = New RegArea '結果工作區對象
objLinArea0.Load '裝入裁剪框工作區
objRegArea1.Load '裝入被裁剪工作區
radiu = 0.0598 '模糊半徑
Op = gisOVLY_INCLIP '裁剪類型-內
rtl = objAnalysis.ClipReg(objLinArea0, objRegArea1, objRegArea2, radiu, Op)

If rtl Then
    MsgBox "裁剪成功"
Else
    MsgBox "裁剪失敗"
End If

Set objLinArea0 = Nothing
Set objRegArea1 = Nothing
Set objRegArea2 = Nothing
End Sub

Private Sub Form_Load()
Set objAnalysis = New Analysis
End Sub


Private Sub Form_Resize()
EditView.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub Form_Terminate()
Set objAnalysis = Nothing

End Sub


Private Sub LinToReg_Click()
'...................線對區的疊加.........................
Dim objLinArea0 As LinArea
Dim objRegArea1 As RegArea
Dim objLinArea2 As LinArea
Dim radiu As Double
Dim Op As Enum_Overlay_Type
Dim rtl As Boolean

Set objLinArea0 = New LinArea '疊加工作區對象
Set objRegArea1 = New RegArea '被疊加工作區對象
Set objLinArea2 = New LinArea '結果工作區對象
objLinArea0.Load '裝入疊加工作區
objRegArea1.Load '裝入被疊加工作區
radiu = 0.01 '模糊半徑
Op = gisOVLY_UNION '疊加類型-并
rtl = objAnalysis.OverlayLinReg(objLinArea0, objRegArea1, objLinArea2, radiu, Op)

If rtl Then
    MsgBox "疊加成功"
Else
    MsgBox "疊加失敗"
End If

Set objLinArea0 = Nothing
Set objRegArea1 = Nothing
Set objLinArea2 = Nothing

End Sub

Private Sub ListLin_Click()
'...............求指定線可變半徑BUFFER區......................

Dim objLinArea As LinArea
Dim r1 As Rad
Dim rBuf As New RadSet
Dim i As Integer
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim knodFlg As Enum_KnobFlg_Type
Dim rtl As Boolean

Set objLinArea = New LinArea
objLinArea.Load  '裝入線文件
Set r1 = New Rad
Set rBuf = New RadSet
For i = 1 To 10
    r1.i = i '圖元號
    r1.r = i * 10 '緩沖區半徑
rBuf.Append r1
Next i
Set objRegArea = New RegArea '生成區工作區實例
useMode = gisGridMode    '光柵化/矢量化
knodFlg = gisRoundKnob  '圓頭/方頭
rtl = objAnalysis.ListLinBuffer(objLinArea, rBuf, objRegArea, useMode, knodFlg)
If rtl Then
    EditView.RegArea = objRegArea
    objRegArea.SaveAs
    EditView.RestoreWindow
    MsgBox "線緩沖區生成成功"
Else
    MsgBox "線緩沖區生成失敗"
End If

Set r1 = Nothing
Set rBuf = Nothing
Set objLinArea = Nothing
Set objRegArea = Nothing
End Sub

Private Sub ListPnt_Click()
'...............求指定點可變半徑BUFFER區......................

Dim objPntArea As PntArea
Dim r1 As Rad
Dim rBuf As RadSet
Dim i As Integer
Dim objRegArea As RegArea
Dim useMode As Enum_UseMode_Type
Dim rtl As Boolean

Set objPntArea = New PntArea
objPntArea.Load '裝入點文件
Set r1 = New Rad
Set rBuf = New RadSet
For i = 1 To 10
r1.i = i '圖元號
r1.r = i  '緩沖區半徑
rBuf.Append r1
Next i
Set objRegArea = New RegArea '生成區工作區實例
useMode = gisVectMode   '光柵化/矢量化
rtl = objAnalysis.ListPntBuffer(objPntArea, rBuf, objRegArea, useMode)
If rtl Then
    MsgBox "線緩沖區生成成功"
Else
    MsgBox "線緩沖區生成失敗"
End If

Set r1 = Nothing
Set rBuf = Nothing
Set objPntArea = Nothing
Set objRegArea = Nothing
End Sub
12 下一頁
?? 文件大小 301 K
?? 上傳用戶 sy780415
?? 所屬分類書籍源碼
??? 相關標簽

#MAPGIS #二次開發
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? analysis.frm

?? 快捷鍵說明
