mosaicrastercom.frm

利用VB、Java、C++实现的AE镶嵌工具。

VERSION 5.00
Begin VB.Form frmMosaicRaster 
   Caption         =   "Mosaic"
   ClientHeight    =   4185
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5955
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4185
   ScaleWidth      =   5955
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame2 
      Caption         =   "Output Properties"
      Height          =   2655
      Left            =   120
      TabIndex        =   7
      Top             =   840
      Width           =   5490
      Begin VB.ComboBox cboColormapMode 
         Height          =   315
         ItemData        =   "MosaicRasterCom.frx":0000
         Left            =   1680
         List            =   "MosaicRasterCom.frx":0010
         TabIndex        =   14
         Top             =   1920
         Width           =   3495
      End
      Begin VB.ComboBox cboResampleType 
         Height          =   315
         ItemData        =   "MosaicRasterCom.frx":003C
         Left            =   1680
         List            =   "MosaicRasterCom.frx":0049
         TabIndex        =   10
         Text            =   "NearestNeighbor"
         Top             =   360
         Width           =   3495
      End
      Begin VB.ComboBox cboDatatype 
         Height          =   315
         ItemData        =   "MosaicRasterCom.frx":0087
         Left            =   1680
         List            =   "MosaicRasterCom.frx":00AC
         TabIndex        =   9
         Top             =   840
         Width           =   3495
      End
      Begin VB.ComboBox cboMosaicType 
         Height          =   315
         ItemData        =   "MosaicRasterCom.frx":0132
         Left            =   1680
         List            =   "MosaicRasterCom.frx":0148
         TabIndex        =   8
         Text            =   "MT_FIRST"
         Top             =   1320
         Width           =   3495
      End
      Begin VB.Label Label1 
         Caption         =   "Colormap mode"
         Height          =   255
         Left            =   360
         TabIndex        =   15
         Top             =   1920
         Width           =   1335
      End
      Begin VB.Label Label10 
         Caption         =   "DataType:"
         Height          =   240
         Left            =   360
         TabIndex        =   13
         Top             =   855
         Width           =   810
      End
      Begin VB.Label Label6 
         Caption         =   "Resample:"
         Height          =   255
         Left            =   360
         TabIndex        =   12
         Top             =   450
         Width           =   975
      End
      Begin VB.Label Label9 
         Caption         =   "Mosaic Type"
         Height          =   255
         Left            =   360
         TabIndex        =   11
         Top             =   1320
         Width           =   1095
      End
   End
   Begin VB.CheckBox chkOutput 
      Caption         =   "Check1"
      Height          =   195
      Left            =   1560
      TabIndex        =   5
      Top             =   3600
      Width           =   255
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   4
      Top             =   3600
      Width           =   915
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "Ok"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   3600
      Width           =   915
   End
   Begin VB.CommandButton cmdOut 
      Height          =   330
      Left            =   5160
      Picture         =   "MosaicRasterCom.frx":0182
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   240
      Width           =   330
   End
   Begin VB.TextBox txtOutRaster 
      Enabled         =   0   'False
      Height          =   285
      Left            =   1560
      TabIndex        =   1
      Top             =   240
      Width           =   3435
   End
   Begin VB.Label Label11 
      Caption         =   "Add layer to map"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   3600
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "Output raster data:"
      Height          =   240
      Left            =   135
      TabIndex        =   0
      Top             =   240
      Width           =   1635
   End
End
Attribute VB_Name = "frmMosaicRaster"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373

' Email: [e-mail]

Option Explicit
Private m_Outraster As String
Private m_Outpath As String
Private m_Format As String
Private m_Extension As String
Private m_OutWs As IWorkspace
Private m_App As IApplication
Private m_MxDoc As IMxDocument
Private m_Map As IMap
Private Sub cmdCancel_Click()
  Unload Me
End Sub
Private Sub cmdOk_Click()
    Dim pLy As ILayer
    Dim pRLy As IRasterLayer
    Dim pRaster() As IRaster
    Dim pRaster1 As IRaster
    Dim pRasterCol As IRasterCollection
    Dim pMosaicRaster As IMosaicRaster
    Dim pSaveAs As ISaveAs
    Dim pRasterDS As IRasterDataset
    Dim pRasProps As IRasterProps
    
    On Error GoTo erh
    Screen.MousePointer = vbHourglass
    If Len(m_Outraster) < 1 Then
      MsgBox "output name is empty"
      Exit Sub
    End If

    Dim LyCount As Integer, i As Integer
    Set pMosaicRaster = New MosaicRaster
    Set pRasterCol = pMosaicRaster
    LyCount = m_Map.LayerCount
    For i = 0 To LyCount - 1
        Set pLy = m_Map.Layer(i)
        If TypeOf pLy Is IRasterLayer Then
            Set pRLy = pLy
            ReDim Preserve pRaster(i) As IRaster
            Set pRaster(i) = pRLy.Raster
            pRasterCol.Append pRaster(i)
        End If
        Set pLy = Nothing
        Set pRLy = Nothing
    Next i
    If cboMosaicType.Text <> "" Then
        pMosaicRaster.MosaicOperatorType = GetMosaicTypeIndex(cboMosaicType.Text)
    End If
    If cboColormapMode.Text <> "" Then
        pMosaicRaster.MosaicColormapMode = GetColormapModeIndex(cboColormapMode.Text)
    End If
    Set pRaster1 = pMosaicRaster
    Set pRasProps = pMosaicRaster
    pRaster1.ResampleMethod = GetResampleTypeIndex(cboResampleType.Text)
    If cboDatatype.Text <> "" Then
        pRasProps.PixelType = GetDataTypeIndex(cboDatatype.Text)
    End If
       
    If m_OutWs Is Nothing Then Set m_OutWs = SetRasterWorkspace(m_Outpath)
    Set pSaveAs = pMosaicRaster
    
    If pSaveAs.CanSaveAs(m_Format) Then
      Set pRasterDS = pSaveAs.SaveAs(m_Outraster, m_OutWs, m_Format)
    End If
    
    'Add to ArcMap if checked
    If chkOutput.Value = 1 Then
        Set pRLy = New RasterLayer
        Set pRaster1 = pRasterDS.CreateDefaultRaster
        pRLy.CreateFromRaster pRaster1
        m_Map.AddLayer pRLy
        m_MxDoc.ActiveView.Refresh
    End If
    GoTo CleanUp
erh:
    MsgBox Err.Description, vbOKOnly, "MosaicRaster"
CleanUp:
    Screen.MousePointer = vbArrow
    Set pRaster1 = Nothing
    Set pLy = Nothing
    Set pRLy = Nothing
    Set pRasterCol = Nothing
    Set pSaveAs = Nothing
    Set pRasterDS = Nothing
    Set pRasProps = Nothing
    Set pMosaicRaster = Nothing
    Set pRasterCol = Nothing
    Set pRaster1 = Nothing
    Unload Me
End Sub
Private Sub cmdOut_Click()
  ' Add raster formats for saving (TIFF, IMAGINE Image, GRID)
  Dim pGxBrowser As IGxDialog
  Dim pGxFilterCol As IGxObjectFilterCollection
  Dim pGxFilter As IGxObjectFilter
  Dim pName As IName
  
  On Error GoTo er
  ' Select input raster dataset
  Set pGxBrowser = New GxDialog
  pGxBrowser.AllowMultiSelect = False
  pGxBrowser.Title = "Specify an Output Raster Dataset"
  
  Set pGxFilter = New GxFilterRasterDatasets
  Set pGxFilterCol = pGxBrowser
  pGxFilterCol.AddFilter pGxFilter, True
    
  If pGxBrowser.DoModalSave(0) Then
    m_Outraster = pGxBrowser.Name
    m_Outpath = pGxBrowser.FinalLocation.FullName
    txtOutRaster = m_Outpath & "\" & m_Outraster
    m_Extension = GetExtension(m_Outraster)
    m_Format = GetFormatFromExt(m_Extension)
    
    Set pName = pGxBrowser.FinalLocation.InternalObjectName
    Set m_OutWs = pName.Open
    
    'Output is geodatabase
    If Not m_OutWs Is Nothing Then m_Format = "SDR"
  End If
  GoTo CleanUp
er:
  MsgBox "Failed to select output raster dataset"
CleanUp:
  Set pGxBrowser = Nothing
  Set pGxFilterCol = Nothing
  Set pGxFilter = Nothing
  Set pName = Nothing
End Sub
Private Sub Form_Load()
    'Get Map
    Set m_MxDoc = m_App.Document
    Set m_Map = m_MxDoc.FocusMap
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Set m_Map = Nothing
    Set m_MxDoc = Nothing
    Set m_App = Nothing
    Set m_OutWs = Nothing
End Sub
Sub init(pApp As IApplication)
    Set m_App = pApp
End Sub