modfunction.bas

有关geomedia的一个全新的gis工程

       Print #1, "RangeInclue" & l & "="; Legend.LegendEntries(j).Ranges(l).Include
          If Legend.LegendEntries(j).Style.Type = "AreaStyle" Then
          Print #1, "AreaBackColor="; Legend.LegendEntries(j).Ranges(l).Style.BackColor
          Print #1, "FillType="; Legend.LegendEntries(j).Ranges(l).Style.FillType
          Print #1, "BoundaryOn="; Legend.LegendEntries(j).Ranges(l).Style.BoundaryOn
            If Legend.LegendEntries(j).Ranges(l).Style.BoundaryOn Then
                Print #1, "BoundaryLineStyle="; Legend.LegendEntries(j).Ranges(l).Style.Boundary.LineStyle
                Print #1, "BoundaryLineWidth="; Legend.LegendEntries(j).Ranges(l).Style.Boundary.Width
                Print #1, "BoundaryLineColor="; Legend.LegendEntries(j).Ranges(l).Style.Boundary.Color
            End If
          ElseIf Legend.LegendEntries(j).Style.Type = "LinearStyle" Then
                Print #1, "LineStyle="; Legend.LegendEntries(j).Ranges(l).Style.Mode
                Print #1, "LineWidth="; Legend.LegendEntries(j).Ranges(l).Style.Width
                Print #1, "LineColor="; Legend.LegendEntries(j).Ranges(l).Style.Color
          
          ElseIf Legend.LegendEntries(j).Style.Type = "SymbolFontStyle" Then
               Print #1, "PointSize="; Legend.LegendEntries(j).Ranges(l).Style.Size
               Print #1, "PointSymbol="; Legend.LegendEntries(j).Ranges(l).Style.FontName
               Print #1, "PointColor="; Legend.LegendEntries(j).Ranges(l).Style.Color
               Print #1, "PointIndex="; Legend.LegendEntries(j).Ranges(l).Style.Index
          ElseIf Legend.LegendEntries(j).Style.Type = "PointSymbolStyle" Then
               Print #1, "PointSize="; Legend.LegendEntries(j).Ranges(l).Style.Size
               Print #1, "PointSymbol="; Legend.LegendEntries(j).Ranges(l).Style.Symbol.Name
               Print #1, "PointColor="; Legend.LegendEntries(j).Ranges(l).Style.Color
          End If
    Next l
    Print #1, "Selected="; Legend.LegendEntries(j).Selected
    Print #1, "StatisticsMode="; Legend.LegendEntries(j).StatisticsMode
    'Print #1, "Status="; Legend.LegendEntries(j).Status
    Print #1, "HeadingFont="; Legend.LegendEntries(j).HeadingFont
    Print #1, "HeadingFontSize="; Legend.LegendEntries(j).HeadingFont.Size
'    Print #1, "HeadingFontColor="; Legend.LegendEntries(j).HeadingFontColor
    Print #1, "SubTitle="; Legend.LegendEntries(j).Subtitle
    Print #1, "SubTitleFont="; Legend.LegendEntries(j).SubtitleFont
    Print #1, "SubTitleFontSize="; Legend.LegendEntries(j).SubtitleFont.Size
'    Print #1, "SubTitleFontColor="; Legend.LegendEntries(j).SubtitleFontColor
    Print #1, "Title="; Legend.LegendEntries(j).Title
    Print #1, "TitleFont="; Legend.LegendEntries(j).TitleFont
    Print #1, "TitleFontSize="; Legend.LegendEntries(j).TitleFont.Size
'    Print #1, "TitleFontColor="; Legend.LegendEntries(j).TitleFontColor
    Print #1, "Visible="; Legend.LegendEntries(j).Visible
    ElseIf Legend.LegendEntries(j).Type = "RecordLegendEntry" Then '####################
    Print #1, "Recordset="; Legend.LegendEntries(j).Recordset.Name
    Print #1, "LegendEntryType="; Legend.LegendEntries(j).Type
    Print #1, "DisplayMode="; Legend.LegendEntries(j).DisplayMode
    Print #1, "GeometryFieldName="; Legend.LegendEntries(j).GeometryFieldName
    Print #1, "Locatable="; Legend.LegendEntries(j).Locatable
    Print #1, "Style="; Legend.LegendEntries(j).Style.Type
          If Legend.LegendEntries(j).Style.Type = "AreaStyle" Then
          Print #1, "AreaBackColor="; Legend.LegendEntries(j).Style.BackColor
          Print #1, "BoundaryOn="; Legend.LegendEntries(j).Style.BoundaryOn
            If Legend.LegendEntries(j).Style.BoundaryOn Then
                Print #1, "BoundaryLineMode="; Legend.LegendEntries(j).Style.Boundary.Mode
                  If Legend.LegendEntries(j).Style.Boundary.Mode = 2 Then
                        Print #1, "BackColor="; Legend.LegendEntries(j).Style.Boundary.BackColor
                        Print #1, "BackStyle="; Legend.LegendEntries(j).Style.Boundary.BackStyle
                        Print #1, "BackWidth="; Legend.LegendEntries(j).Style.Boundary.BackWidth
                        Print #1, "ForeColor="; Legend.LegendEntries(j).Style.Boundary.ForeColor
                        Print #1, "ForeStyle="; Legend.LegendEntries(j).Style.Boundary.ForeStyle
                        Print #1, "ForeWidth="; Legend.LegendEntries(j).Style.Boundary.ForeWidth
                  ElseIf Legend.LegendEntries(j).Style.Boundary.Mode = 0 Then
                       Print #1, "ForeColor="; Legend.LegendEntries(j).Style.Boundary.ForeColor
                        Print #1, "ForeStyle="; Legend.LegendEntries(j).Style.Boundary.ForeStyle
                        Print #1, "ForeWidth="; Legend.LegendEntries(j).Style.Boundary.ForeWidth
                  ElseIf Legend.LegendEntries(j).Style.Boundary.Mode = 1 Then
                       Print #1, "BackColor="; Legend.LegendEntries(j).Style.Boundary.BackColor
                        Print #1, "BackStyle="; Legend.LegendEntries(j).Style.Boundary.BackStyle
                        Print #1, "BackWidth="; Legend.LegendEntries(j).Style.Boundary.BackWidth
                  End If
            End If
          Print #1, "FillType="; Legend.LegendEntries(j).Style.FillType
          Print #1, "FillMode="; Legend.LegendEntries(j).Style.FillMode
            If Legend.LegendEntries(j).Style.FillMode = gmsFillModeEnhanced Then
                Print #1, "ForeColor="; Legend.LegendEntries(j).Style.ForeColor
                Print #1, "HatchSpacing="; Legend.LegendEntries(j).Style.HatchSpacing
                Print #1, "HatchWidth="; Legend.LegendEntries(j).Style.HatchWidth
            ElseIf Legend.LegendEntries(j).Style.FillMode = gmsFillModeStandard Then
                Print #1, "ForeColor="; Legend.LegendEntries(j).Style.ForeColor
            End If
          ElseIf Legend.LegendEntries(j).Style.Type = "LinearStyle" Then
                Print #1, "Mode="; Legend.LegendEntries(j).Style.Mode
                If Legend.LegendEntries(j).Style.Mode = gmsLinearModeShowBoth Then
                   Print #1, "LineBackColor="; Legend.LegendEntries(j).Style.BackColor
                   Print #1, "LineBackStyle="; Legend.LegendEntries(j).Style.BackStyle
                   Print #1, "LineBackWidth="; Legend.LegendEntries(j).Style.BackWidth
                   Print #1, "LineForeColor="; Legend.LegendEntries(j).Style.ForeColor
                   Print #1, "LineForeStyle="; Legend.LegendEntries(j).Style.ForeStyle
                   Print #1, "LineForeWidth="; Legend.LegendEntries(j).Style.ForeWidth
                ElseIf Legend.LegendEntries(j).Style.Mode = gmsLinearModeShowForeground Then
                   Print #1, "LineForeColor="; Legend.LegendEntries(j).Style.ForeColor
                   Print #1, "LineForeStyle="; Legend.LegendEntries(j).Style.ForeStyle
                   Print #1, "LineForeWidth="; Legend.LegendEntries(j).Style.ForeWidth
                ElseIf Legend.LegendEntries(j).Style.Mode = gmsLinearModeShowBackground Then
                   Print #1, "LineBackColor="; Legend.LegendEntries(j).Style.BackColor
                   Print #1, "LineBackStyle="; Legend.LegendEntries(j).Style.BackStyle
                   Print #1, "LineBackWidth="; Legend.LegendEntries(j).Style.BackWidth
                End If
          ElseIf Legend.LegendEntries(j).Style.Type = "SymbolFontStyle" Then
               Print #1, "PointSize="; Legend.LegendEntries(j).Style.Size
               Print #1, "PointSymbol="; Legend.LegendEntries(j).Style.FontName
               Print #1, "PointColor="; Legend.LegendEntries(j).Style.Color
               Print #1, "PointIndex="; Legend.LegendEntries(j).Style.Index
          ElseIf Legend.LegendEntries(j).Style.Type = "PointSymbolStyle" Then
               Print #1, "PointSize="; Legend.LegendEntries(j).Style.Size
               Print #1, "PointSymbol="; Legend.LegendEntries(j).Style.Symbol.Name
               Print #1, "PointColor="; Legend.LegendEntries(j).Style.Color
          ElseIf Legend.LegendEntries(j).Style.Type = "TextStyle" Then
              'Print #1, "TextBoxColor="; Legend.LegendEntries(j).Style.BoxStyle.Color
              'Print #1, "TextBoxLineStyle="; Legend.LegendEntries(j).Style.BoxStyle.LineStyle
              'Print #1, "TextBoxLineWidth="; Legend.LegendEntries(j).Style.BoxStyle.Width
              Print #1, "TextColor="; Legend.LegendEntries(j).Style.Color
              Print #1, "TextFontName="; Legend.LegendEntries(j).Style.Font.Name
              Print #1, "TextFontSize="; Legend.LegendEntries(j).Style.Font.Size
              
          End If
                Print #1, "Selected="; Legend.LegendEntries(j).Selected
                'Print #1, "Status="; Legend.LegendEntries(j).Status
                'Print #1, "SubTitle="; Legend.LegendEntries(j).Subtitle
                'Print #1, "SubTitleFont="; Legend.LegendEntries(j).SubtitleFont
                'Print #1, "SubTitleFontColor="; Legend.LegendEntries(j).SubtitleFontColor
                Print #1, "Title="; Legend.LegendEntries(j).Title
                Print #1, "TitleFont="; Legend.LegendEntries(j).TitleFont
                Print #1, "TitleFontSize="; Legend.LegendEntries(j).TitleFont.Size
                'Print #1, "TitleFontColor="; Legend.LegendEntries(j).TitleFontColor
                Print #1, "Visible="; Legend.LegendEntries(j).Visible
                
    End If
    Next j
    Close #1

End Function
Public Function OpenWorkSpace(WorkSpacePath As String, SymboFilePath As String, Connection As PClient.Connection, MapViewOcx As GMMapView)
Dim strTemp As String
Dim strKey As String
Dim iTemp As Integer
Dim DBWork As GDatabase
Dim RecordsetWork As GRecordset
Dim objSFSWork As SymbolFileService
Dim objFontWork As Font
Dim ColorsWork() As Long
Dim iUniqueValue As Integer
Dim iRangeValue As Integer
Dim objColorWork As ColorScheme, objColorsWork As ColorSchemes
Dim iTempColor As Integer
Dim strnamework As String
Dim objSYMWork As Symbol
Dim objPSSWork As PointSymbolStyle
Dim objStyle As Object
Set objSFSWork = CreateObject("Geomedia.SymbolFileService")
objSFSWork.FileName = SymboFilePath
Open WorkSpacePath For Input As #1
    Line Input #1, strTemp
    strKey = GetSimpleStr(strTemp)
    OpenDatabase 1, strKey, "", "", "", ""
    Line Input #1, strTemp
    strKey = GetSimpleStr(strTemp)
    For iTemp = 1 To Int(strKey)
        Set DBWork = Connection.Database
        Line Input #1, strTemp
        strKey = GetSimpleStr(strTemp)
        Set RecordsetWork = DBWork.OpenRecordset(strKey, gdbOpenDynaset)
        Line Input #1, strTemp
        strKey = GetSimpleStr(strTemp)
        If strKey = "UniqueValueLegendEntry" Then '************************************
                Dim objUVLWork As UniqueValueLegendEntry
                Set objUVLWork = CreateObject("Geomedia.UniqueValueLegendEntry")
                Set objColorsWork = CreateObject("Geomedia.ColorSchemes")
                Set objColorWork = CreateObject("Geomedia.ColorScheme")
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                ReDim ColorsWork(Int(strKey))
                   For iTempColor = 0 To Int(strKey) - 1
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    ColorsWork(iTempColor) = (strKey)
                   Next iTempColor
                        With objColorWork
                            .Colors = ColorsWork()
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .Name = strKey
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .Type = CInt(strKey)
                        End With
                objColorsWork.Append objColorWork
                Set objUVLWork.ColorSchemes = objColorsWork
                Set objColorWork = Nothing
                Set objColorsWork = Nothing
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                objUVLWork.ColorSchemeIndex = CInt(strKey)
                With objUVLWork
                 Line Input #1, strTemp
                 strKey = GetSimpleStr(strTemp)
                 .Ascending = CBool(strKey)
                 Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .AttributeFieldName = strKey
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .Collapsed = CBool(strKey)
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .ContentsMode = CInt(strKey)
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .DisplayMode = CInt(strKey)
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .GeometryFieldName = strKey
                Set .Recordset = RecordsetWork
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .Locatable = CBool(strKey)
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                Select Case strKey
                       Case "PointSymbolStyle"
                            strnamework = objSFSWork.SymbolNames.Item(1)
                            Set objSYMWork = objSFSWork.GetSymbol(strnamework)
                            Set objPSSWork = CreateObject("GeoMedia.PointSymbolStyle")
                            Set objPSSWork.Symbol = objSYMWork
                            Set .Style = objPSSWork
                       Case "AreaStyle"
                           Set .Style = New AreaStyle
                       Case "LinearStyle"
                           Set .Style = New LinearStyle
                       Case "SymbolFontStyle"
                           Set .Style = New SymbolFontStyle
                End Select
                Dim UniqueStyle As String
                UniqueStyle = strKey
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .SetValues gmalUniqueValueByFieldValues
                If UniqueStyle = "LinearStyle" Then
                    For iUniqueValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.Mode = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.Width = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.Color = CLng(strKey)
                    Next iUniqueValue
                ElseIf UniqueStyle = "AreaStyle" Then
                    For iUniqueValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.BackColor = CLng(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.FillType = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.BoundaryOn = CBool(strKey)
                        If CBool(strKey) Then
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .UniqueValues(iUniqueValue).Style.Boundary.LineStyle = CInt(strKey)
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .UniqueValues(iUniqueValue).Style.Boundary.Width = CDbl(strKey)
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .UniqueValues(iUniqueValue).Style.Boundary.Color = CLng(strKey)
                        End If
                    Next iUniqueValue
                
                ElseIf UniqueStyle = "PointSymbolStyle" Then
                    For iUniqueValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Include = CBool(strKey)
                    Line Input #1, strTemp