form1.frm

里面有我用VB二次开发MAPGIS的20个例子

VERSION 5.00
Object = "{9AA8CA21-F911-11D2-A123-000021EA413B}#1.0#0"; "msicom.dll"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   2880
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSICOMLibCtl.MsiControl MsiControl1 
      Height          =   2175
      Left            =   600
      OleObjectBlob   =   "Form1.frx":0000
      TabIndex        =   0
      Top             =   240
      Width           =   2895
   End
   Begin VB.Menu File 
      Caption         =   "文件"
      Begin VB.Menu Open 
         Caption         =   "打开"
      End
      Begin VB.Menu ImportTif 
         Caption         =   "输入Tif"
      End
      Begin VB.Menu ExportTIF 
         Caption         =   "输出Tif"
      End
      Begin VB.Menu Close 
         Caption         =   "关闭"
      End
   End
   Begin VB.Menu Tool 
      Caption         =   "缩放工具"
      Begin VB.Menu ZoomIn 
         Caption         =   "放大"
      End
      Begin VB.Menu ZoomOut 
         Caption         =   "缩小"
      End
   End
   Begin VB.Menu Bianhuan 
      Caption         =   "图象变换"
      Begin VB.Menu invert 
         Caption         =   "反转变换"
      End
      Begin VB.Menu rgb 
         Caption         =   "彩色显示图象"
      End
   End
   Begin VB.Menu Filtermsi 
      Caption         =   "图象滤波"
      Begin VB.Menu Filter 
         Caption         =   "滤波"
      End
   End
   Begin VB.Menu jisuan 
      Caption         =   "图象计算"
      Begin VB.Menu TwoLayersDiff 
         Caption         =   "图象差值"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dataset As New MsiDataSet
Dim dataconnect As New MsiDataConnection
Dim layers As New MsiLayers
Dim layer As New MsiLayer
Dim dlg As New msidlg

Private Sub Close_Click()
    layers.msiClear
    MsiControl1.msiRefresh
End Sub

Private Sub ExportTIF_Click()
    On Error GoTo Errhandle
    Dim ImportFile As String
    Dim ResultFile As String
    ImportFile = MsiControl1.layers.msiItem(1).dataset.strname
    dlg.msiExportTifFile ImportFile, ResultFile
    ResultFile = ""
    Exit Sub
Errhandle:
    MsgBox "错误号：" & _
    Str(Err.Number) & ";错误描述：" & Err.Description & _
    "。", vbInformation, "程序出错"
End Sub

Private Sub Filter_Click()
On Error GoTo Errhandle
    Dim ImportFile As String
    Dim ResultFile As String
    ImportFile = MsiControl1.layers.msiItem(1).dataset.strname
    dlg.msiImgFilter ImportFile, ResultFile
    Exit Sub
Errhandle:
    MsgBox "错误号：" & _
    Str(Err.Number) & ";错误描述：" & Err.Description & _
    "。", vbInformation, "程序出错"
End Sub

Private Sub Form_Load()
    dataconnect.msiConnect
    Set layers = MsiControl1.layers
    Form_Resize
End Sub

Private Sub Form_Resize()
    MsiControl1.Left = 0
    MsiControl1.Top = 0
    MsiControl1.Width = Me.Width
    MsiControl1.Height = Me.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
    dataconnect.msiDisConnect
End Sub

Private Sub ImportTif_Click()
Dim Tempfile As String
On Error GoTo ERROREND
    Dim strname As String
    strname = ""
    With CommonDialog1
        .CancelError = False
        .ShowOpen
        strname = .FileName
        If strname = "" Then
            Exit Sub
        End If
   End With
   dlg.msiImportTifFile strname, Tempfile
   OpenFile Tempfile
   Exit Sub
ERROREND:
    MsgBox "Open FAILED"
End Sub

Private Sub invert_Click()
    If layers.lCount > 0 Then
        layer.lGrayConvertForm = msiLinearGrayConvert
        MsiControl1.msiRefresh
    End If
End Sub

Private Sub Open_Click()
    Dim strname As String
    strname = ""
    With CommonDialog1
        .CancelError = False
        .ShowOpen
        strname = .FileName
        If strname = "" Then
            Exit Sub
        End If
   End With
   OpenFile strname
End Sub
Private Sub OpenFile(strname As String)
On Error GoTo ERROREND
   layers.msiClear
   If strname = "" Then
    Exit Sub
   End If
   Set dataset = dataconnect.msiAddDataSet(strname)
   layer.dataset = dataset
   layers.msiAdd layer
   MsiControl1.msiRefresh
   Exit Sub
ERROREND:
    MsgBox "Open FAILED"
   
End Sub
Private Sub rgb_Click()
    If layers.lCount > 0 Then
        dlg.msiSelectRGBBandNo layers.msiItem(1)
        MsiControl1.msiRefresh
    End If
End Sub

Private Sub TwoLayersDiff_Click()
On Error GoTo Errhandle
    Dim ImportFile As String
    Dim ResultFile As String
    ImportFile = MsiControl1.layers.msiItem(1).dataset.strname
    ResultFile = ""
    dlg.msiFormult ImportFile, ResultFile, "两图层差值", " (I1 - I2)"
    OpenFile ResultFile
    Exit Sub
Errhandle:
    MsgBox "错误号：" & _
    Str(Err.Number) & ";错误描述：" & Err.Description & _
    "。", vbInformation, "程序出错"

End Sub

Private Sub ZoomIn_Click()
    MsiControl1.msiZoomIn
End Sub

Private Sub ZoomOut_Click()
    MsiControl1.msiZoomOut
End Sub