modfunction.bas

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

                    strKey = GetSimpleStr(strTemp)
                    objPSSWork.Size = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    Set objPSSWork.Symbol = objSFSWork.GetSymbol(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    objPSSWork.Color = CLng(strKey)
                    Next iUniqueValue
                
                ElseIf UniqueStyle = "SymbolFontStyle" Then
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    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.Size = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iRangeValue).Style.FontName = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.Color = CLng(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .UniqueValues(iUniqueValue).Style.Index = CInt(strKey)
                    Next iUniqueValue
                End If
                   Line Input #1, strTemp
                   strKey = GetSimpleStr(strTemp)
                   .Selected = CBool(strKey)
                    Line Input #1, strTemp
                   strKey = GetSimpleStr(strTemp)
                   .StatisticsMode = CInt(strKey)
                  Set objFontWork = CreateObject("StdFont")
                      With objFontWork
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Name = strKey
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Size = CDbl(strKey)
                      End With
                 Set .HeadingFont = objFontWork
                 Set objFontWork = Nothing
                 Line Input #1, strTemp
                 strKey = GetSimpleStr(strTemp)
                 .Subtitle = strKey
                 Set objFontWork = CreateObject("StdFont")
                      With objFontWork
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Name = strKey
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Size = CDbl(strKey)
                      End With
                Set .SubtitleFont = objFontWork
                Set objFontWork = Nothing
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .Title = strKey
                Set objFontWork = CreateObject("StdFont")
                      With objFontWork
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Name = strKey
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Size = CDbl(strKey)
                      End With
                Set .TitleFont = objFontWork
                Set objFontWork = Nothing
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                .Visible = CBool(strKey)
                End With
                If objUVLWork.ValidateSource And objUVLWork.Status = gmlEntryValid Then
                    If MapViewOcx.Legend.LegendEntries.Count = 0 Then
                        MapViewOcx.Legend.LegendEntries.Append objUVLWork
                    Else
                        MapViewOcx.Legend.LegendEntries.Append objUVLWork, 1
                    End If
                    objUVLWork.LoadData
                End If
        ElseIf strKey = "RangeLegendEntry" Then '******************************************
                Dim objRLEWork As RangeLegendEntry
                Set objRLEWork = CreateObject("Geomedia.RangeLegendEntry")
                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) = CLng(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 objRLEWork.ColorSchemes = objColorsWork
                Set objColorWork = Nothing
                Set objColorsWork = Nothing
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                objRLEWork.ColorSchemeIndex = CInt(strKey)
                With objRLEWork
                 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 RangeStyle As String
                RangeStyle = strKey
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .SetRanges gmalRangeByEqualCount, CInt(strKey)
                If RangeStyle = "LinearStyle" Then
                    For iRangeValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Mode = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Width = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Color = CLng(strKey)
                    Next iRangeValue
                ElseIf RangeStyle = "AreaStyle" Then
                    For iRangeValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.BackColor = CLng(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.FillType = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.BoundaryOn = CBool(strKey)
                        If CBool(strKey) Then
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .Ranges(iRangeValue).Style.Boundary.LineStyle = CInt(strKey)
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .Ranges(iRangeValue).Style.Boundary.Width = CDbl(strKey)
                            Line Input #1, strTemp
                            strKey = GetSimpleStr(strTemp)
                            .Ranges(iRangeValue).Style.Boundary.Color = CLng(strKey)
                        End If
                    Next iRangeValue
                
                ElseIf RangeStyle = "PointSymbolStyle" Then
                    For iRangeValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    objPSSWork.Size = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    Set objPSSWork.Symbol = objSFSWork.GetSymbol(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    objPSSWork.Color = CLng(strKey)
                    Set .Ranges(iRangeValue).Style = objPSSWork
                    Next iRangeValue
                
                ElseIf RangeStyle = "SymbolFontStyle" Then
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    For iRangeValue = 1 To CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Description = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Include = CBool(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Size = CInt(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.FontName = strKey
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Color = CLng(strKey)
                    Line Input #1, strTemp
                    strKey = GetSimpleStr(strTemp)
                    .Ranges(iRangeValue).Style.Index = CInt(strKey)
                    Next iRangeValue
                End If
                   Line Input #1, strTemp
                   strKey = GetSimpleStr(strTemp)
                   .Selected = CBool(strKey)
                    Line Input #1, strTemp
                   strKey = GetSimpleStr(strTemp)
                   .StatisticsMode = CInt(strKey)
                  Set objFontWork = CreateObject("StdFont")
                      With objFontWork
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Name = strKey
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Size = CDbl(strKey)
                      End With
                 Set .HeadingFont = objFontWork
                 Set objFontWork = Nothing
                 Line Input #1, strTemp
                 strKey = GetSimpleStr(strTemp)
                 .Subtitle = strKey
                 Set objFontWork = CreateObject("StdFont")
                      With objFontWork
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Name = strKey
                        Line Input #1, strTemp
                        strKey = GetSimpleStr(strTemp)
                        .Size = CDbl(strKey)
                      End With
                Set .SubtitleFont = objFontWork
                Set objFontWork = Nothing
                Line Input #1, strTemp
                strKey = GetSimpleStr(strTemp)
                .Title = strKey
                Set objFo