frmsavegeoset.frm

MapX4.0在VB中的应用例子

    
    'Set the Tool Icons
    pctTools(1).Picture = ilstIcons.ListImages(4).Picture
    pctTools(2).Picture = ilstIcons.ListImages(2).Picture
    pctTools(3).Picture = ilstIcons.ListImages(3).Picture
    
    'Set the current tool
    Map1.CurrentTool = miZoomInTool
    
    'Set the icons for the File buttons
    pctFileIO(1).Picture = ilstIcons.ListImages(7).Picture
    pctFileIO(2).Picture = ilstIcons.ListImages(8).Picture
    pctFileIO(3).Picture = ilstIcons.ListImages(9).Picture
    
    'Get the location of the GST and map files
    strTemp = QueryValue("SOFTWARE\MapInfo\MapX\4.0", "GeoDictionary")
    
    'At this point strTemp looks something like this -> C:\Program Files\MapInfo\MapX\4.0\Maps\Geodict.dct
    'We just need the path
    
    'Search the string from right to elft
     For intCounter = Len(strTemp) To 1 Step -1
        'If we find a '\' then we have the path (all of the character to the left of it)
         If Mid$(strTemp, intCounter, 1) = "\" Then
            'Set the variable
            mstrPathtoGSTs = Left$(strTemp, intCounter)
            'Get out of the loop
            Exit For
         End If
      Next
      
     'Get the full path and filename of the current geoset
     mstrLastUsedFile = Map1.Geosets(Map1.Geoset).PathName
     
End Sub

Private Sub Form_Resize()
'*****************************************************************************************************
'This routine is called whenever the user resizes the main window.
Map1.Width = frmGeoSets.Width - fraMapViewTools.Left - fraMapViewTools.Width - 100
Map1.Height = frmGeoSets.Height - 100

End Sub

Private Sub mnuFile1_Click(Index As Integer)
'*****************************************************************************************************
'This is called any time the user chooses an item from the File
'
'The Index Numbers go a little something like this :
'File
'    New Geoset         100
'    Open Geoset        101
'    Save Geoset        102
'    Exit                    199
'    Divider Bar         499
'    MRU1                 500
'    MRU2                 501
'    MRU3                 502
'    MRU4                 503

On Error GoTo JRS_GENERIC_ERROR_HANDLER:

Select Case Index
    Case 100 'New Geoset
            'Clear the Geoset, so we start with a new one
            Map1.Geoset = ""
            'Update the Geoset Name text
            txtGeoSetName.Text = "Geoset Name"
            'Allow the user to choose what coordinate system
            Map1.DisplayCoordSys.PickCoordSys
            'Allow the user to add new layers
            Map1.Layers.LayersDlg
            'Update the LastUsedFile variable
            mstrLastUsedFile = mstrPathtoGSTs & "Geoset1.GST"
            
    Case 101 'Open a Geoset
            'Using the Windows CommonDialog control
            With comFileIO
                .DialogTitle = "Open GeoSet"
                .DefaultExt = "GST"
                'Don't show the 'Open as Read Only' checkbox
                .Flags = cdlOFNHideReadOnly
                'Look for the most recently used file as a default
                .filename = mstrLastUsedFile
                'Give user the option of *.GST or *.* for file types
                .Filter = "MapX geoset (*.GST) |*.GST|All Files(*.*)|*.*"
                'By default show *.GST (1st item from the Filter property)
                .FilterIndex = 1
                'Trip an erro if the user hits cancel (so we can trap for it)
                .CancelError = True
                'Action 1 is to show as file open
                .Action = 1
            End With
            
            'As long as we don't have a blank
            If comFileIO.filename <> "" Then
                'Load the geoset
                Map1.Geoset = comFileIO.filename
                'Show the Geoset name
                txtGeoSetName.Text = Map1.Geosets(Map1.Geoset).UserName
                'Hide the title text
                Map1.Title.Visible = False
                'Write to the registry with the new file
                Call UpdateMRUList(comFileIO.filename)
                'Update the file menu
                Call UpdateFileMenu
                'Update the LastUsed variable
                mstrLastUsedFile = comFileIO.filename
            End If
    
    Case 102 'Save the Geoset
            With comFileIO
                .DialogTitle = "Save GeoSet"
                .DefaultExt = "GST"
                'Show a warning dialog if user is going to overwrite, hide the 'read only' checkbox, path that user types in, must exist
                .Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly Or cdlOFNPathMustExist
                .filename = mstrLastUsedFile
                .Filter = "MapX Geoset (*.GST)|*.GST|All Files(*.*)|*.*"
                .FilterIndex = 1
                .CancelError = True
                'Action 2 is Show Save
                .Action = 2
            End With
                        
            If comFileIO.filename <> "" Then
                Dim strName As String
                'If you try and create a freindly geoset name longer than 255 character, it doesn't get written to the *.GST file
                If Len(txtGeoSetName.Text) > 255 Then
                    'If it's too big, grab the left most 255 characters
                    strName = Left$(txtGeoSetName.Text, 255)
                Else
                    'Else, copy the whole thing
                    strName = txtGeoSetName.Text
                End If
                'Save the Geoset
                Map1.SaveMapAsGeoset strName, comFileIO.filename
                'Update things (next 3 lines)
                mstrLastUsedFile = comFileIO.filename
                Call UpdateMRUList(comFileIO.filename)
                Call UpdateFileMenu
                'View the text using NOTEPAD
                'Shell "NOTEPAD.exe " & comFileIO.filename, vbNormalFocus
            End If
            
    Case 199 'Exit
            End
    Case 500, 501, 502, 503
            'These are the 1st,2nd,3rd,4th most recently used file, respectively
            
            Dim strFileNameWithoutNumber As String
            'The menu caption for the MRU's looks like this:
            '  1. C:\MapInfo\MDLand\Maps\Sales.GST   [with the 1 being underscored]
            'As a string, VB sees it as
            '  &1. C:\MapInfo\MDLand\Maps\Sales.GST
            'So we need to pull out just the FileName and get rid of the number
            strFileNameWithoutNumber = Trim$(Right$(mnufile1(Index).Caption, Len(mnufile1(Index).Caption) - 4))
                        
            'Make sure that the file still exists (it could have been deleted since last used)
            If FileExists(strFileNameWithoutNumber) = True Then
                'Set the Geoset
                Map1.Geoset = strFileNameWithoutNumber 'mnufile1(Index).Caption
                'Update the textbox
                txtGeoSetName.Text = Map1.Geosets(Map1.Geoset).UserName
                'Make the title invisible
                Map1.Title.Visible = False
                'Update things (next 3 lines)
                mstrLastUsedFile = Map1.Geosets(Map1.Geoset).PathName
                Call UpdateMRUList(strFileNameWithoutNumber)
                Call UpdateFileMenu
            End If
End Select

Exit Sub

JRS_GENERIC_ERROR_HANDLER:
    Select Case Err.Number
        Case 32755 'User hit cancel
             'Do nothing.  No file will be saved or opened
        Case Else 'Most likely, an error trying to open notepad
             Resume Next
    End Select
End Sub

Private Sub pctFileIO_Click(Index As Integer)
    '**********************************************************************************************
    'CAlled when the user clicks on one of the file icons [New, Open, Save]
    Select Case Index
        Case 1 'New Geoset
            Call mnuFile1_Click(100)
        Case 2 'Open Geoset
            Call mnuFile1_Click(101)
        Case 3 'Save Geoset
            Call mnuFile1_Click(102)
    End Select
End Sub

Private Sub pctTools_Click(Index As Integer)

'Set all tools to the "up button" icon
pctTools(1).Picture = ilstIcons.ListImages(1).Picture
pctTools(2).Picture = ilstIcons.ListImages(2).Picture
pctTools(3).Picture = ilstIcons.ListImages(3).Picture

'Get the "down button" picture from the image list control
pctTools(Index).Picture = ilstIcons.ListImages(Index + 3).Picture

'Set the current tool
Select Case Index
    Case 1
        Map1.CurrentTool = miZoomInTool
    Case 2
        Map1.CurrentTool = miZoomOutTool
    Case 3
        Map1.CurrentTool = miPanTool
End Select
End Sub

Public Sub UpdateMRUList(ByVal strGeosetPath As String)
'*****************************************************************************************************
'Here we write to the registry, keeping track of the 4 most recently used files
'  If the newest file is not in the list, we add that as the 1st and bump #2 to #3, and #3 to #4, and 4 gets thrown away
' If the newest file is in the list, we just have to shuffle the list around.  The variable *intNumMatch* will point to the
'Item it matches with

Dim strMRU1 As String, strMRU2 As String, strMRU3, strMRU4 As String
Dim intNumMatch As Integer

'Set the variables which will hold the filenames of the most recently used files.  I used UCASE$ so that they would all
'be in uppercase, so we don't have to worry about case inconsistancies
strMRU1 = UCase$(QueryValue("SOFTWARE\MapInfo\GeosetManager", "MRU1"))
strMRU2 = UCase$(QueryValue("SOFTWARE\MapInfo\GeosetManager", "MRU2"))
strMRU3 = UCase$(QueryValue("SOFTWARE\MapInfo\GeosetManager", "MRU3"))
strMRU4 = UCase$(QueryValue("SOFTWARE\MapInfo\GeosetManager", "MRU4"))

'Uppercase the name of the file that was passed as a parameter to this function
strGeosetPath = UCase$(strGeosetPath)

'Right now, the new file doesn't match any of the existing filenames
intNumMatch = 0

'You can't take the LEFT$() of an empty string
If Len(strMRU1) > 0 Then
    'If we have a match between the #1 most recently used and the current file, set the matched variable to 1
    'I use the left$() here, because the strMRU1 has an additional character (NULL char, I think) at the end
    If Left$(strMRU1, Len(strMRU1) - 1) = strGeosetPath Then intNumMatch = 1
End If

'Repeat the above process to check if the current file matches the #2, #3, or #4 MRUfiles

If Len(strMRU2) > 0 Then
    If Left$(strMRU2, Len(strMRU2) - 1) = strGeosetPath Then intNumMatch = 2
End If

If Len(strMRU3) > 0 Then
    If Left$(strMRU3, Len(strMRU3) - 1) = strGeosetPath Then intNumMatch = 3
End If

If Len(strMRU4) > 0 Then
    If Left$(strMRU4, Len(strMRU4) - 1) = strGeosetPath Then intNumMatch = 4
End If


Select Case intNumMatch
        'Depending on (if there was a match)/(which one it matched) update the reg entries
        Case 0
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU1", strGeosetPath, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU2", strMRU1, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU3", strMRU2, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU4", strMRU3, REG_SZ
        Case 1
            'It was the first in the list, everything stays the same
            
        Case 2
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU1", strMRU2, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU2", strMRU1, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU3", strMRU3, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU4", strMRU4, REG_SZ
        Case 3
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU1", strMRU3, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU2", strMRU1, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU3", strMRU2, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU4", strMRU4, REG_SZ
        Case 4
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU1", strMRU4, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU2", strMRU1, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU3", strMRU2, REG_SZ
            SetKeyValue "SOFTWARE\MapInfo\GeosetManager", "MRU4", strMRU3, REG_SZ
        
End Select

End Sub

Public Sub UpdateFileMenu()
'*************************************************************************************************
'This sub reads the registry entries and updates the File menu with the names of most recently used files
    
    Dim intCounter As Integer
    Dim strTemp As String
    
    'Turn the dividing bar off
    mnufile1(499).Visible = False
    
    'Loop through the 4 menu items (Index numbers 500,501,502,503
    For intCounter = 500 To 503
            'read the registry entry, getting key MRU1, MRU2, MRU3 or MRU4
            strTemp = QueryValue("SOFTWARE\MapInfo\GeosetManager", "MRU" & Trim$(Str$(intCounter - 499)))
            'If the key exists (it won't the first time you run this program)
            If Len(strTemp) > 1 Then
                'Make the menu item visible
                mnufile1(intCounter).Visible = True
                'Set it's caption
                mnufile1(intCounter).Caption = "&" & (intCounter - 499) & ".  " & strTemp
                'Show the divider bar
                mnufile1(499).Visible = True
            Else
                'Make the menu item invisible
                mnufile1(intCounter).Visible = False
            End If
    Next
End Sub

Function FileExists(filename As String) As Integer
'********************************************************************************************
'This function deermines whether or not a file exists, hence the name FileExists.
    
    Dim i As Integer
    On Error Resume Next
        i = Len(Dir$(filename))
            If Err Or i = 0 Then
                FileExists = False
                Else
                FileExists = True
    End If
End Function