clspublic.cls

该源码实现了mapx5的一些新功能

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPublic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'********************************************************************************
'File Name   ：clsPublic.cls
'Description ：define public consts or functions
'Author      ：James Liu
'Copyright   ：MapInfo China
'Create Date ：2002年9月11日
'********************************************************************************

Public g_bShowCursorCoord As Boolean
Public g_bSnaped As Boolean

Public Function GetUniqueLayerName(ByVal objMap As MapXLib.Map, ByVal sFilePath As String) As String
On Error Resume Next
    
Dim sFileName As String
Dim sLayerName As String
Dim aFileName() As String
Dim iCount As Integer, i As Integer
Dim oLayer As MapXLib.Layer

    aFileName = Split(sFilePath, "\", -1, vbTextCompare)
    sFileName = aFileName(UBound(aFileName))
    sFileName = Left(sFileName, Len(sFileName) - 4)
    iCount = 0
    For i = 1 To objMap.Layers.Count
        Set oLayer = objMap.Layers(i)
        sLayerName = oLayer.Name
        If Len(sLayerName) = Len(sFileName) Then
            If StrComp(sLayerName, sFileName, vbTextCompare) = 0 Then
                iCount = iCount + 1
            End If
        ElseIf Len(sLayerName) > Len(sFileName) Then
            If StrComp(Left(sLayerName, Len(sFileName)), sFileName, vbTextCompare) = 0 And _
                Mid(sLayerName, Len(sFileName) + 1, 1) = "_" Then
                iCount = iCount + 1
            End If
            
        End If
    Next i
    
    If iCount = 0 Then
        GetUniqueLayerName = sFileName
    Else
        GetUniqueLayerName = sFileName & "_" & CStr(iCount)
    End If
    
End Function


Public Function GetUniqueLayerNamebySQL(ByVal objMap As MapXLib.Map, ByVal sSQL As String) As String
On Error Resume Next
    
Dim sUCaseSQL As String
Dim sLayerName As String
Dim aTableName() As String
Dim sTableName As String
Dim iCount As Integer, i As Integer
Dim oLayer As MapXLib.Layer
    
    sUCaseSQL = Trim(UCase(sSQL))
    aTableName = Split(sSQL, "FROM", -1, vbTextCompare)
    sTableName = Trim(aTableName(UBound(aTableName)))
    aTableName = Split(sTableName, "WHERE", -1, vbTextCompare)
    sTableName = RTrim(aTableName(LBound(aTableName)))
    iCount = 0
    For i = 1 To objMap.Layers.Count
        Set oLayer = objMap.Layers(i)
        sLayerName = oLayer.Name
        If Len(sLayerName) = Len(sTableName) Then
            If StrComp(sLayerName, sTableName, vbTextCompare) = 0 Then
                iCount = iCount + 1
            End If
        ElseIf Len(sLayerName) > Len(sTableName) Then
            If StrComp(Left(sLayerName, Len(sTableName)), sTableName, vbTextCompare) = 0 And _
                Mid(sLayerName, Len(sTableName) + 1, 1) = "_" Then
                iCount = iCount + 1
            End If
            
        End If
    Next i
    
    If iCount = 0 Then
        GetUniqueLayerNamebySQL = sTableName
    Else
        GetUniqueLayerNamebySQL = sTableName & "_" & CStr(iCount)
    End If
    
End Function


Public Function GetFileNamefromPath(ByVal sFilePath As String) As String
On Error Resume Next

Dim sFileName As String
Dim aFileName() As String

    aFileName = Split(sFilePath, "\", -1, vbTextCompare)
    sFileName = aFileName(UBound(aFileName))
    sFileName = Left(sFileName, Len(sFileName) - 4)
    GetFileNamefromPath = sFileName

End Function

Public Function LayerExist(ByVal objMap As MapXLib.Map, ByVal sLayerName As String) As Boolean
On Error Resume Next
Dim oLayer As MapXLib.Layer
    Set oLayer = objMap.Layers(sLayerName)
    If Err.Number > 0 Then
        LayerExist = False
    Else
        LayerExist = True
    End If
    Set oLayer = Nothing
End Function

Private Sub Class_Initialize()
    g_bShowCursorCoord = False
    g_bSnaped = False
End Sub

Public Function GetUniqueLayerNamebyStr(ByVal objMap As MapXLib.Map, ByVal value As String) As String
On Error Resume Next
    
Dim sFileName As String
Dim sLayerName As String
Dim iCount As Integer, i As Integer
Dim oLayer As MapXLib.Layer

    sFileName = value
    iCount = 0
    For i = 1 To objMap.Layers.Count
        Set oLayer = objMap.Layers(i)
        sLayerName = oLayer.Name
        If Len(sLayerName) = Len(sFileName) Then
            If StrComp(sLayerName, sFileName, vbTextCompare) = 0 Then
                iCount = iCount + 1
            End If
        ElseIf Len(sLayerName) > Len(sFileName) Then
            If StrComp(Left(sLayerName, Len(sFileName)), sFileName, vbTextCompare) = 0 And _
                Mid(sLayerName, Len(sFileName) + 1, 1) = "_" Then
                iCount = iCount + 1
            End If
            
        End If
    Next i
    
    If iCount = 0 Then
        GetUniqueLayerNamebyStr = sFileName
    Else
        GetUniqueLayerNamebyStr = sFileName & "_" & CStr(iCount)
    End If
    
End Function