保存工程文件的代码[包括layers, renderers, extents, and graphic shapes in a text file]

<P>代码下载地址</P>
<P><a href="attachment/2005-1/2005115104632318.zip">2005-1/2005115104632318.zip</a></P>
<P>Private Sub openProject()
  Dim i As Integer
  Dim j As Integer
  Dim path As String
  Dim Test As Boolean
  Dim projectFile As String
  Dim numLayers As Integer
  Dim layerCount As Integer
  Dim filetext As String
  Dim theLayerType As MapObjects2.LayerTypeConstants
  Dim theName As String
  Dim thefile As String
  Dim fileName As String
  Dim covName As String
  Dim curPath As String
  Dim theShapeType As MapObjects2.ShapeTypeConstants
  Dim themenumber As Long
  Dim thefiletype As String
  Dim theSymbology As String
  Dim theValueCount As Integer
  Dim theBreakCount As Integer
  Dim theField As String
  Dim theSymbolType As MapObjects2.SymbolTypeConstants
  Dim theValue As Variant
  Dim theBreak As Double
  Dim theStyle As Integer
  Dim theColor As Long
  Dim theSize As Integer
  Dim theOutline As Boolean
  Dim theOutlineColor As Long
  Dim theFont As String
  Dim theCharacterIndex As Long
  Dim theFontBold As Boolean
  Dim theRotation As Integer
  Dim hasRenderer As Boolean
  Dim vLayer As MapObjects2.MapLayer
  Dim iLayer As MapObjects2.ImageLayer
  Dim vmr As New MapObjects2.ValueMapRenderer
  Dim cbr As New MapObjects2.ClassBreaksRenderer
  Dim lbr As New MapObjects2.LabelRenderer
  Dim gpr As New MapObjects2.GroupRenderer
  Dim theRendererCount As Integer
  Dim thePointCount As Long
  Dim thePointtext As String
  Dim thePoints As New MapObjects2.points
  Dim apoint As New MapObjects2.Point
  Dim comPos As Integer
  Dim rectmeasure As Double
  Dim textPos As Integer
  Dim periodPos As Integer
  Dim tempChar As String
  Dim aLayer As Object
  Dim theRecs As New MapObjects2.Recordset
  Dim extentRect As New MapObjects2.Rectangle
  
  'Execute common dialog for selecting a file to open.
  
  Dim strProject As String
  strProject = "Project files (*.mpf) |*.mpf"
  ' Set CancelError is True
  CommonDialog1.CancelError = True
  On Error GoTo FileOpenCancel
  
  CommonDialog1.InitDir = App.path ; "\Projects"
  CommonDialog1.Filter = strProject
  CommonDialog1.DialogTitle = "Select Project file"
  CommonDialog1.ShowOpen
  
  'We have the full path name from the common dialog. Parse out base path.
  If CommonDialog1.FileTitle = "" Then Exit Sub
  projectFile = Trim$(CommonDialog1.fileName)
  'MsgBox projectFile
  
  'Clear map layers
  mapDisp.Layers.Clear
  
  'Clear all Graphics
  Call ClearAllGraphics
  'Remove selected features
  Set g_selectedFeatures = Nothing</P>
<P>    frmProgress.Show vbModeless
    frmProgress.Left = 3500
    frmProgress.Top = 3000
    frmProgress.ProgressBar1.Value = 1
    frmProgress.lblStatus = "Opening File ..."
  Open projectFile For Input As 1
  'get extent first
  'MsgBox "setting extent"
    Input #1, filetext
    extentRect.Left = filetext
    Input #1, filetext
    extentRect.Right = filetext
    Input #1, filetext
    extentRect.Top = filetext
    Input #1, filetext
    extentRect.Bottom = filetext
    'Get the number of layers
    Input #1, filetext
    numLayers = CInt(filetext)
    layerCount = 1
  'Get Layers next
    Input #1, filetext
    Do Until filetext = "END ALL LAYERS"
        theLayerType = Int(filetext)
        If (theLayerType = moMapLayer) Then
            'MsgBox str(theLayerType)
            Input #1, theName
            Input #1, theShapeType
            Input #1, themenumber
            Input #1, thefiletype
            Input #1, curPath
            Input #1, fileName
            frmProgress.ProgressBar1.Value = layerCount / numLayers * 100
            frmProgress.lblStatus = "Opening File ..." ; theName
            DoEvents
            'MsgBox theName
            'MsgBox str(thethemenumber)
            'MsgBox theTag
             If (thefiletype = "[SHAPEFILE]") Then
                  Call addShapeFile(curPath, fileName)
                  Set vLayer = mapDisp.Layers(0)
                  If vLayer.Name = "SelectedFeatures" Then
                    'MsgBox vLayer.Name
                    Set g_selectedFeatures = vLayer.Records
                    sbrStatus.Panels(3).text = Str(vLayer.Records.count) ; " features selected."
                  End If
              ElseIf (thefiletype = "[COVERAGE]") Then
                  Call addCoverage(curPath, fileName, "version7")
                  Set vLayer = mapDisp.Layers(0)
              End If
              Test = False
              If mapDisp.Layers.count > 1 Then
                mapDisp.Layers.MoveToBottom (0)
              End If
              Input #1, theSymbology
              'MsgBox theSymbology
              If (theSymbology = "VALUE MAP RENDERER") Then
                Input #1, theValueCount
                Input #1, theField
                Input #1, theSymbolType
                'MsgBox theField
                Set vmr = vLayer.Renderer
                vmr.ValueCount = theValueCount
                vmr.Field = theField
                vmr.SymbolType = theSymbolType
                For i = 0 To theValueCount - 1
                    Input #1, theValue
                    vmr.Value(i) = theValue
                    Input #1, theStyle
                    vmr.symbol(i).style = theStyle
                    Input #1, theColor
                    vmr.symbol(i).color = theColor
                    Input #1, theSize
                    vmr.symbol(i).Size = theSize
                    If (vmr.SymbolType = moFillSymbol) Then
                        Input #1, theOutline
                        vmr.symbol(i).Outline = theOutline
                        Input #1, theOutlineColor
                        vmr.symbol(i).OutlineColor = theOutlineColor
                    ElseIf (vmr.SymbolType = moPointSymbol) Then
                        If (vmr.symbol(i).style = moTrueTypeMarker) Then
                            Input #1, theFont
                            vmr.symbol(i).Font = theFont
                            Input #1, theCharacterIndex
                            vmr.symbol(i).CharacterIndex = theCharacterIndex
                        End If
                    End If
                Next i
                vLayer.Renderer = vmr
              ElseIf (theSymbology = "CLASS BREAKS RENDERER") Then
                Set cbr = vLayer.Renderer
                Input #1, theBreakCount
                cbr.BreakCount = theBreakCount
                Input #1, theField
                cbr.Field = theField
                Input #1, theSymbolType
                cbr.SymbolType = theSymbolType
                For i = 0 To cbr.BreakCount - 1
                    Input #1, theBreak
                    cbr.Break(i) = theBreak
                    Input #1, theStyle
                    cbr.symbol(i).style = theStyle
                    Input #1, theColor
                    cbr.symbol(i).color = theColor
                    Input #1, theSize
                    cbr.symbol(i).Size = theSize
                    If (cbr.SymbolType = moFillSymbol) Then
                        Input #1, theOutline
                        cbr.symbol(i).Outline = theOutline
                        Input #1, theOutlineColor
                        cbr.symbol(i).OutlineColor = theOutlineColor
                    ElseIf (cbr.SymbolType = moPointSymbol) Then
                        If (cbr.symbol(i).style = moTrueTypeMarker) Then
                            Input #1, theFont
                            cbr.symbol(i).Font = theFont
                            Input #1, theCharacterIndex
                            cbr.symbol(i).CharacterIndex = theCharacterIndex
                        End If
                    End If
                Next i
                vLayer.Renderer = cbr
              ElseIf (theSymbology = "GROUP RENDERER") Then
                Input #1, theRendererCount
                Set gpr = vLayer.Renderer
                For j = 0 To theRendererCount - 1
                    Input #1, theSymbology
                    'MsgBox "GPR = " ; theSymbology
                    If (theSymbology = "VALUE MAP RENDERER") Then
                        Input #1, theValueCount
                        Input #1, theField
                        Input #1, theSymbolType
                        vmr.ValueCount = theValueCount
                        'MsgBox str(theValueCount)
                        vmr.Field = theField
                        vmr.SymbolType = theSymbolType
                        For i = 0 To theValueCount - 1
                            Input #1, theValue
                            'MsgBox theValue
                            vmr.Value(i) = theValue
                            Input #1, theStyle
                            vmr.symbol(i).style = theStyle
                            Input #1, theColor
                            vmr.symbol(i).color = theColor
                            Input #1, theSize
                            vmr.symbol(i).Size = theSize
                            If (vmr.SymbolType = moFillSymbol) Then
                                Input #1, theOutline
                                vmr.symbol(i).Outline = theOutline
                                Input #1, theOutlineColor
                                vmr.symbol(i).OutlineColor = theOutlineColor
                            ElseIf (vmr.SymbolType = moPointSymbol) Then
                                If (vmr.symbol(i).style = moTrueTypeMarker) Then
                                    Input #1, theFont
                                    vmr.symbol(i).Font = theFont
                                    Input #1, theCharacterIndex
                                    vmr.symbol(i).CharacterIndex = theCharacterIndex
                                End If
                            End If
                        Next i
                        gpr.Add vmr
                    ElseIf (theSymbology = "CLASS BREAKS RENDERER") Then
                        Input #1, theBreakCount
                        cbr.BreakCount = theBreakCount
                        Input #1, theField
                        cbr.Field = theField
                        Input #1, theSymbolType
                        cbr.SymbolType = theSymbolType
                        For i = 0 To cbr.BreakCount - 1
                            Input #1, theBreak
                            cbr.Break(i) = theBreak
                            Input #1, theStyle
                            cbr.symbol(i).style = theStyle
                            Input #1, theColor
                            cbr.symbol(i).color = theColor
                            Input #1, theSize
                            cbr.symbol(i).Size = theSize
                            If (cbr.SymbolType = moFillSymbol) Then
                                Input #1, theOutline
                                cbr.symbol(i).Outline = theOutline
                                Input #1, theOutlineColor
                                cbr.symbol(i).OutlineColor = theOutlineColor
                            ElseIf (cbr.SymbolType = moPointSymbol) Then
                                If (cbr.symbol(i).style = moTrueTypeMarker) Then
                                    Input #1, theFont
                                    cbr.symbol(i).Font = theFont
                                    Input #1, theCharacterIndex
                                    cbr.symbol(i).CharacterIndex = theCharacterIndex
                                End If
                            End If
                        Next i
                        gpr.Add cbr
                    Else 'Is LabelRenderer
                        i = 0
                        Input #1, theField
                        lbr.Field = theField
                        Input #1, theFont
                        lbr.symbol(0).Font = theFont
                        Input #1, theFontBold
                        lbr.symbol(0).Font.Bold = theFontBold
                        Input #1, theColor
                        lbr.symbol(0).color = theColor
                        Input #1, theSize
                        lbr.symbol(0).Height = theSize
                        lbr.DrawBackground = False
                        gpr.Add lbr
                    End If
                Next j
                vLayer.Renderer = gpr
              ElseIf (theSymbology = "SINGLE SYMBOL") Then
                i = 0
                Input #1, theStyle
                vLayer.symbol.style = theStyle
                Input #1, theColor
                vLayer.symbol.color = theColor
                Input #1, theSize
                vLayer.symbol.Size = theSize
                If (theShapeType = moShapeTypePolygon) Then
                    Input #1, theOutline
                    vLayer.symbol.Outline = theOutline
                    Input #1, theOutlineColor
                    vLayer.symbol.OutlineColor = theOutlineColor
                ElseIf (theShapeType = moShapeTypePoint) Then
                    If (vLayer.symbol.style = moTrueTypeMarker) Then
                        Input #1, theFont
                        vLayer.symbol.Font = theFont
                        Input #1, theCharacterIndex
                        vLayer.symbol.CharacterIndex = theCharacterIndex
                    End If
                End If
                Input #1, hasRenderer
                If (hasRenderer) Then
                  i = 0
                  'MsgBox "label renderer started"
                  Input #1, theSymbology
                  Input #1, theField
                  lbr.Field = theField
                  Input #1, theFont
                  lbr.symbol(0).Font = theFont
                  Input #1, theFontBold
                  lbr.symbol(0).Font.Bold = theFontBold
                  Input #1, theColor
                  lbr.symbol(0).color = theColor
                  Input #1, theSize
                  lbr.symbol(0).Height = theSize
                  lbr.DrawBackground = False
                  'MsgBox "label renderer added"
                  vLayer.Renderer = lbr
                End If
              Else
                MsgBox "Error Reading Project File", vbCritical
                Exit Sub
              End If 'theSymbology test
        Else 'Layer is image layer
            Input #1, theName
            Input #1, thefile
            Call addImage(thefile)
            mapDisp.Layers(mapDisp.Layers.count - 1).Name = theName
        End If
        If theName = "County Boundary" Then
            mapDisp.Extent = extentRect
            mapDisp.Refresh
            legmapdisp.LoadLegend
        End If
        legmapdisp.LoadLegend
        Call setlegend
        Set vLayer = Nothing
        Set iLayer = Nothing
        Set vmr = Nothing
        Set cbr = Nothing
        Set lbr = Nothing
        Set gpr = Nothing
        Input #1, filetext
        layerCount = layerCount + 1
    Loop 'Until End all layers
    'Layers are done - Process graphics
    frmProgress.ProgressBar1.Value = 90
    frmProgress.lblStatus = "Restoring Graphics..."
    DoEvents
    Input #1, filetext
    Do Until filetext = "END GRAPHICS"
    If (filetext = "TEXT GRAPHICS") Then
      'set up layer to get a line object
      Input #1, textindex
      ReDim Preserve strGText(textindex)
      ReDim Preserve textShape(textindex)
      ReDim Preserve textSym(textindex)
      For i = 0 To textindex - 1
        Input #1, thePointtext
        Input #1, strGText(i)
        'MsgBox strGText(i)
        If (Len(strGText(i)) = 0 Or strGText(i) = "Nothing") Then
            strGText(i) = ""
            Set textShape(i) = Nothing
            Set textSym(i) = Nothing
        Else
            Input #1, thePointtext
            textShape(i).X = CDbl(thePointtext)
            Input #1, thePointtext
            textShape(i).Y = CDbl(thePointtext)
            Input #1, theFont
            textSym(i).Font = theFont
            Input #1, theColor
            textSym(i).color = theColor
            Input #1, theSize
            textSym(i).Height = theSize
            Input #1, theRotation
            textSym(i).Rotation = theRotation
        End If
      Next i
    ElseIf (filetext = "POINT GRAPHICS") Then
      'MsgBox "adding points"
      Input #1, pointindex
      ReDim ptGraphic(pointindex)
      ReDim pointSym(pointindex)
      For i = 0 To pointindex - 1
        Input #1, thePointtext
        Input #1, thePointtext
        If (Len(thePointtext) = 0 Or thePointtext = "Nothing") Then
            Set ptGraphic(i) = Nothing
            Set pointSym(i) = Nothing
        Else
            Set ptGraphic(i) = New MapObjects2.Point
            ptGraphic(i).X = thePointtext
            Input #1, thePointtext
            ptGraphic(i).Y = thePointtext
            pointSym(i).SymbolType = moPointSymbol
            Input #1, theStyle
            pointSym(i).style = theStyle
            If (theStyle = 4) Then
                Input #1, theFont
                pointSym(i).Font = theFont
                Input #1, theCharacterIndex
                pointSym(i).CharacterIndex = theCharacterIndex
            End If
            Input #1, theColor
            pointSym(i).color = theColor
            Input #1, theSize
            pointSym(i).Size = theSize
        End If
      Next i
    ElseIf (filetext = "LINE GRAPHICS") Then
      Input #1, lineindex
      ReDim lnGraphic(lineindex)
      ReDim lineSym(lineindex)
      For i = 0 To lineindex - 1
        Input #1, thePointCount
        Input #1, thePointtext
        If (thePointtext = "Nothing") Then
            Set lnGraphic(i) = Nothing
            Set lineSym(i) = Nothing
        Else
            Set lnGraphic(i) = New MapObjects2.Line
            Set thePoints = New MapObjects2.points
            For j = 0 To CLng(thePointtext) - 1
                Set apoint = New MapObjects2.Point
                Input #1, thePointCount
                apoint.X = CDbl(thePointCount)
                Input #1, thePointCount
                apoint.Y = CDbl(thePointCount)
                thePoints.Add apoint
            Next j
            lnGraphic(i).Parts.Add thePoints
            'MsgBox "created line " ; i
            lineSym(i).SymbolType = moLineSymbol
            Input #1, theStyle
            lineSym(i).style = theStyle
            Input #1, theColor
            lineSym(i).color = theColor
            Input #1, theSize
            lineSym(i).Size = theSize
        End If
      Next i
      'MsgBox str(lineSym(lineindex - 1).Size)
    ElseIf (filetext = "RECTANGLE GRAPHICS") Then
      Input #1, rectindex
      ReDim rectGraphic(rectindex)
      ReDim rectSym(rectindex)
      For i = 0 To rectindex - 1
        Input #1, thePointCount
        Input #1, thePointtext
        If (Len(thePointtext) = 0 Or thePointtext = "Nothing") Then
           MsgBox "rect " ; Str(i) ; " deleted."
            Set rectGraphic(i) = Nothing
            Set rectSym(i) = Nothing
        Else
           MsgBox "restoring rect " ; Str(i)
            Set rectGraphic(i) = New MapObjects2.Rectangle
            rectGraphic(i).Left = CDbl(thePointtext)
            Input #1, rectmeasure
            rectGraphic(i).Right = rectmeasure
            Input #1, rectmeasure
            rectGraphic(i).Top = rectmeasure
            Input #1, rectmeasure
            rectGraphic(i).Bottom = rectmeasure
            rectSym(i).SymbolType = moFillSymbol
            Input #1, theStyle
</P>

            rectSym(i).style = theStyle
            Input #1, theColor
            rectSym(i).color = theColor
            Input #1, theOutline
            rectSym(i).Outline = theOutline
            Input #1, theOutlineColor
            rectSym(i).OutlineColor = theOutlineColor
            Input #1, theSize
            rectSym(i).Size = theSize
        End If
      Next i
    ElseIf (filetext = "POLYGON GRAPHICS") Then
      'MsgBox "Polygons"
      Input #1, polyindex
      ReDim polyGraphic(polyindex)
      ReDim polySym(polyindex)
      For i = 0 To polyindex - 1
        Input #1, thePointCount
        Input #1, thePointtext
        'MsgBox thePointtext
        If (Len(thePointtext) = 0 Or thePointtext = "Nothing") Then
           'MsgBox "poly " ; Str(i) ; " deleted."
            Set polyGraphic(i) = Nothing
            Set polySym(i) = Nothing
        Else
            Set polyGraphic(i) = New MapObjects2.Polygon
            Set thePoints = New MapObjects2.points
            'MsgBox Str(thePointtext)
            For j = 0 To CLng(thePointtext) - 1
                Set apoint = New MapObjects2.Point
                Input #1, thePointCount
                apoint.X = CDbl(thePointCount)
                Input #1, thePointCount
                'MsgBox thePointCount
                apoint.Y = CDbl(thePointCount)
                thePoints.Add apoint
            Next j
            polyGraphic(i).Parts.Add thePoints
            'MsgBox "created line " ; i
            polySym(i).SymbolType = moFillSymbol
            Input #1, theStyle
            polySym(i).style = theStyle
            Input #1, theColor
            polySym(i).color = theColor
            Input #1, theOutline
            polySym(i).Outline = theOutline
            Input #1, theOutlineColor
            polySym(i).OutlineColor = theOutlineColor
            Input #1, theSize
            polySym(i).Size = theSize
        End If
      Next i
    ElseIf (filetext = "CIRCLE GRAPHICS") Then
      Input #1, cirindex
      ReDim cirGraphic(cirindex)
      ReDim cirSym(cirindex)
      For i = 0 To cirindex - 1
        Input #1, thePointCount
        Input #1, thePointtext
        If (Len(thePointtext) = 0 Or thePointtext = "Nothing") Then
            Set cirGraphic(i) = Nothing
            Set cirSym(i) = Nothing
        Else
            Set cirGraphic(i) = New MapObjects2.Ellipse
            cirGraphic(i).Left = CDbl(thePointtext)
            Input #1, rectmeasure
            cirGraphic(i).Right = rectmeasure
            Input #1, rectmeasure
            cirGraphic(i).Top = rectmeasure
            Input #1, rectmeasure
            cirGraphic(i).Bottom = rectmeasure
            cirSym(i).SymbolType = moFillSymbol
            Input #1, theStyle
            cirSym(i).style = theStyle
            Input #1, theColor
            cirSym(i).color = theColor
            Input #1, theOutline
            cirSym(i).Outline = theOutline
            Input #1, theOutlineColor
            cirSym(i).OutlineColor = theOutlineColor
            Input #1, theSize
            cirSym(i).Size = theSize
        End If
      Next i
    Else
        MsgBox "Error retrieving Graphics"
        Exit Sub
    End If
    Input #1, filetext
  Loop
    'End graphics
    Call sortThemes
      For i = 1 To tbrZoom.Buttons.count
        tbrZoom.Buttons(i).Value = tbrUnpressed
      Next i
      For i = 1 To tbrGraphics.Buttons.count
        tbrGraphics.Buttons(i).Value = tbrUnpressed
      Next i
      For i = 1 To tbrSelect.Buttons.count
        tbrSelect.Buttons(i).Value = tbrUnpressed
      Next i
    Call frmGetLayers.updatelist
    Call frmGetLayers.updatebuttons
    legmapdisp.LoadLegend True
    Call setlegend
    mapDisp.Refresh
  Close #1
'MsgBox "Done"
    frmProgress.ProgressBar1.Value = 100
    frmProgress.lblStatus = "Finished..."
    frmProgress.lblStatus = ""
    Unload frmProgress
  sbrStatus.Panels(3).text = "Project restored successfully!"
FileOpenCancel:
  Exit Sub<P>End Sub</P><P>Private Sub saveProject()
  'This procedure sets up the common dialog and returns a shapefile or image file
  'for processing into the Layers collection.</P><P>  Dim path As String
  Dim Test As Boolean
  Dim projectFile As String
  Dim baseName As String
  Dim pLayer As Object
  Dim pRenderer As Object
  Dim gRenderer As Object
  Dim i As Integer
  Dim j As Integer
  Dim thePoints As New MapObjects2.points
  Dim atabledef As TableDef
  Dim fs
  Dim dbfFile
  Dim hasRenderer As Boolean
  
  'Execute common dialog for selecting a file to open.
  
  Dim strProject As String
  strProject = "BooneMap Project files (*.bpf) |*.bpf"
  ' Set CancelError is True
  CommonDialog1.CancelError = True
  On Error GoTo FileOpenCancel
  
  CommonDialog1.InitDir = App.path ; "\Projects"
  CommonDialog1.Filter = strProject
  CommonDialog1.DialogTitle = "Save Project file"
  CommonDialog1.ShowSave
  
  'We have the full path name from the common dialog. Parse out base path.
  If CommonDialog1.FileTitle = "" Then Exit Sub
  projectFile = Trim$(CommonDialog1.fileName)
  'MsgBox projectFile
  'extract the name portion of projectFile
  Dim textPos As Long
  Dim tempChar As String
  Dim fileName As String
  Dim themenumber As Long
  Dim fileType As String
  Dim thePath As String
  Dim therest As String
  textPos = Len(projectFile)
  Test = False
  'This loop goes backwards through the string, searching for the
  'last back slash. This marks the base path from the returned string.
  Do While Test = False
    textPos = textPos - 1
    tempChar = Mid$(projectFile, textPos, 1)
    If tempChar = "\" Or textPos = 0 Then
    Test = True
    End If
  Loop
  'Create the file name for the access table names...
  fileName = Right$(projectFile, Len(projectFile) - textPos)
  Open projectFile For Output As 1
  'first write the current map extents
  Write #1, mapDisp.Extent.Left
  Write #1, mapDisp.Extent.Right
  Write #1, mapDisp.Extent.Top
  Write #1, mapDisp.Extent.Bottom
  'next write out each of the layers
  'first write the number of layers
  Write #1, mapDisp.Layers.count
  For Each pLayer In mapDisp.Layers
    hasRenderer = False
    If (pLayer.LayerType = moMapLayer) Then
  'Get Layers first
        Write #1, pLayer.LayerType
        Write #1, pLayer.Name
        Write #1, pLayer.shapetype
        themenumber = CLng(GetFirstToken(pLayer.tag, ","))
        therest = Right(pLayer.tag, Len(pLayer.tag) - (Len(Str(themenumber))))
        Write #1, themenumber
        fileType = GetFirstToken(therest, ";")
        therest = Right(therest, Len(therest) - (Len(fileType) + 1))
        Write #1, fileType
        thePath = GetFirstToken(therest, "|")
        therest = Right(therest, Len(therest) - (Len(thePath) + 1))
        Write #1, thePath
        Write #1, therest
          If (Not pLayer.Renderer Is Nothing) Then
            hasRenderer = True
            Set pRenderer = pLayer.Renderer
            If (TypeOf pRenderer Is ValueMapRenderer) Then
                Write #1, "VALUE MAP RENDERER"
                Write #1, pRenderer.ValueCount
                Write #1, pRenderer.Field
                Write #1, pRenderer.SymbolType
                For i = 0 To pRenderer.ValueCount - 1
                    Write #1, pRenderer.Value(i)
                    If (pRenderer.SymbolType = moFillSymbol) Then
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                        Write #1, pRenderer.symbol(i).Outline
                        Write #1, pRenderer.symbol(i).OutlineColor
                    ElseIf (pRenderer.SymbolType = moLineSymbol) Then
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                    Else 'Point Symbol
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                        If (pRenderer.symbol(i).style = moTrueTypeMarker) Then
                            Write #1, pRenderer.symbol(i).Font.Name
                            Write #1, pRenderer.symbol(i).CharacterIndex
                        End If
                    End If
                Next i
            ElseIf (TypeOf pRenderer Is ClassBreaksRenderer) Then
                Write #1, "CLASS BREAKS RENDERER"
                Write #1, pRenderer.BreakCount
                Write #1, pRenderer.Field
                Write #1, pRenderer.SymbolType
                For i = 0 To pRenderer.BreakCount - 1
                    Write #1, pRenderer.Break(i)
                    If (pRenderer.SymbolType = moFillSymbol) Then
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                        Write #1, pRenderer.symbol(i).Outline
                        Write #1, pRenderer.symbol(i).OutlineColor
                    ElseIf (pRenderer.SymbolType = moLineSymbol) Then
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                    Else 'Point Symbol
                        Write #1, pRenderer.symbol(i).style
                        Write #1, pRenderer.symbol(i).color
                        Write #1, pRenderer.symbol(i).Size
                        If (pRenderer.symbol(i).style = moTrueTypeMarker) Then
                            Write #1, pRenderer.symbol(i).Font.Name
                            Write #1, pRenderer.symbol(i).CharacterIndex
                        End If
                    End If
                Next i
            ElseIf (TypeOf pRenderer Is LabelRenderer) Then 'Single Symbol
                Write #1, "SINGLE SYMBOL"
                If (pLayer.shapetype = moShapeTypePolygon) Then
                    Write #1, pLayer.symbol.style
                    Write #1, pLayer.symbol.color
                    Write #1, pLayer.symbol.Size
                    Write #1, pLayer.symbol.Outline
                    Write #1, pLayer.symbol.OutlineColor
                ElseIf (pLayer.shapetype = moShapeTypeLine) Then
                    Write #1, pLayer.symbol.style
                    Write #1, pLayer.symbol.color
                    Write #1, pLayer.symbol.Size
                Else 'point layer
                    Write #1, pLayer.symbol.style
                    Write #1, pLayer.symbol.color
                    Write #1, pLayer.symbol.Size
                    If (pLayer.symbol.style = moTrueTypeMarker) Then
                        Write #1, pLayer.symbol.Font.Name
                        Write #1, pLayer.symbol.CharacterIndex
                    End If
                End If
                Write #1, hasRenderer
                If (pRenderer.Field <> "") Then
                  Write #1, "LABEL RENDERER"
                  Write #1, pRenderer.Field
                  Write #1, pRenderer.symbol(0).Font.Name
                  Write #1, pRenderer.symbol(0).Font.Bold
                  Write #1, pRenderer.symbol(0).color
                  Write #1, pRenderer.symbol(0).Height
                End If
            Else 'GroupRenderer
                Write #1, "GROUP RENDERER"
                Write #1, pRenderer.count
                For j = 0 To pRenderer.count - 1
                    Set gRenderer = pRenderer.Renderer(j)
                    'MsgBox gRenderer.Field
                    If (TypeOf gRenderer Is ValueMapRenderer) Then
                        Write #1, "VALUE MAP RENDERER"
                        Write #1, gRenderer.ValueCount
                        Write #1, gRenderer.Field
                        Write #1, gRenderer.SymbolType
                        For i = 0 To gRenderer.ValueCount - 1
                            Write #1, gRenderer.Value(i)
                            If (gRenderer.SymbolType = moFillSymbol) Then
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                                Write #1, gRenderer.symbol(i).Outline
                                Write #1, gRenderer.symbol(i).OutlineColor
                            ElseIf (gRenderer.SymbolType = moLineSymbol) Then
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                            Else 'Point Symbol
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                                If (gRenderer.symbol(i).style = moTrueTypeMarker) Then
                                    Write #1, gRenderer.symbol(i).Font.Name
                                    Write #1, gRenderer.symbol(i).CharacterIndex
                                End If
                            End If
                        Next i
                    ElseIf (TypeOf gRenderer Is ClassBreaksRenderer) Then
                        Write #1, "CLASS BREAKS RENDERER"
                        Write #1, gRenderer.BreakCount
                        Write #1, gRenderer.Field
                        Write #1, gRenderer.SymbolType
                        For i = 0 To gRenderer.BreakCount - 1
                            Write #1, gRenderer.Break(i)
                            If (gRenderer.SymbolType = moFillSymbol) Then
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                                Write #1, gRenderer.symbol(i).Outline
                                Write #1, gRenderer.symbol(i).OutlineColor
                            ElseIf (gRenderer.SymbolType = moLineSymbol) Then
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                            Else 'Point Symbol
                                Write #1, gRenderer.symbol(i).style
                                Write #1, gRenderer.symbol(i).color
                                Write #1, gRenderer.symbol(i).Size
                                If (gRenderer.symbol(i).style = moTrueTypeMarker) Then
                                    Write #1, gRenderer.symbol(i).Font.Name
                                    Write #1, gRenderer.symbol(i).CharacterIndex
                                End If
                            End If
                        Next i
                    Else 'Is LabelRenderer
                      If (gRenderer.Field <> "") Then
                        Write #1, "LABEL RENDERER"
                        Write #1, gRenderer.Field
                        Write #1, gRenderer.symbol(0).Font.Name
                        Write #1, gRenderer.symbol(0).Font.Bold
                        Write #1, gRenderer.symbol(0).color
                        Write #1, gRenderer.symbol(0).Height
                      End If
                    End If
                Next j
            End If
        Else 'Single Symbol - No renderer
            Write #1, "SINGLE SYMBOL"
            If (pLayer.shapetype = moShapeTypePolygon) Then
                Write #1, pLayer.symbol.style
                Write #1, pLayer.symbol.color
                Write #1, pLayer.symbol.Size
                Write #1, pLayer.symbol.Outline
                Write #1, pLayer.symbol.OutlineColor
            ElseIf (pLayer.shapetype = moShapeTypeLine) Then
                Write #1, pLayer.symbol.style
                Write #1, pLayer.symbol.color
                Write #1, pLayer.symbol.Size
            Else 'point layer
                Write #1, pLayer.symbol.style
                Write #1, pLayer.symbol.color
                Write #1, pLayer.symbol.Size
                If (pLayer.symbol.style = moTrueTypeMarker) Then
                    Write #1, pLayer.symbol.Font.Name
                    Write #1, pLayer.symbol.CharacterIndex
                End If
            End If
            Write #1, hasRenderer
        End If ' not pLayer.Renderer is Nothing
    Else 'pLayer is Image Layer
        Write #1, pLayer.LayerType
        Write #1, pLayer.Name
        Write #1, pLayer.File
    End If
  Next pLayer
  Write #1, "END ALL LAYERS"
    If (textindex > 0) Then
      Write #1, "TEXT GRAPHICS"
      Write #1, textindex
      For i = 0 To textindex - 1
        Write #1, i
        If (Len(strGText(i)) > 0 And Not textShape(i) Is Nothing) Then
            Write #1, strGText(i)
            Write #1, textShape(i).X; textShape(i).Y
            Write #1, textSym(i).Font
            Write #1, textSym(i).color
            Write #1, textSym(i).Height
            Write #1, textSym(i).Rotation
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    If (pointindex > 0) Then
      Write #1, "POINT GRAPHICS"
      Write #1, pointindex
      For i = 0 To pointindex - 1
        Write #1, i
        If (Not ptGraphic(i) Is Nothing) Then
            Write #1, ptGraphic(i).X; ptGraphic(i).Y
            Write #1, pointSym(i).style
            If (pointSym(i).style = moTrueTypeMarker) Then
                Write #1, pointSym(i).Font
                Write #1, pointSym(i).CharacterIndex
            End If
            Write #1, pointSym(i).color
            Write #1, pointSym(i).Size
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    If (lineindex > 0) Then
      Write #1, "LINE GRAPHICS"
      Write #1, lineindex
      For i = 0 To lineindex - 1
        Write #1, i
        If (Not lnGraphic(i) Is Nothing) Then 'add the shape to the file
            Write #1, lnGraphic(i).Parts(0).count
            For j = 0 To lnGraphic(i).Parts(0).count - 1
                Write #1, lnGraphic(i).Parts(0).Item(j).X, lnGraphic(i).Parts(0).Item(j).Y
            Next j
            Write #1, lineSym(i).style
            Write #1, lineSym(i).color
            Write #1, lineSym(i).Size
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    'MsgBox "done with lines"
    If (rectindex > 0) Then
      Write #1, "RECTANGLE GRAPHICS"
      Write #1, rectindex
      For i = 0 To rectindex - 1
        Write #1, i
        If (Not rectGraphic(i) Is Nothing) Then
            Write #1, rectGraphic(i).Left
            Write #1, rectGraphic(i).Right
            Write #1, rectGraphic(i).Top
            Write #1, rectGraphic(i).Bottom
            Write #1, rectSym(i).style
            Write #1, rectSym(i).color
            Write #1, rectSym(i).Outline
            Write #1, rectSym(i).OutlineColor
            Write #1, rectSym(i).Size
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    If (polyindex > 0) Then
      Write #1, "POLYGON GRAPHICS"
      Write #1, polyindex
      For i = 0 To polyindex - 1
        Write #1, i
        If (Not polyGraphic(i) Is Nothing) Then 'add the shape to the file
          Write #1, polyGraphic(i).Parts(0).count
            For j = 0 To polyGraphic(i).Parts(0).count - 1
                Write #1, polyGraphic(i).Parts(0).Item(j).X, polyGraphic(i).Parts(0).Item(j).Y
            Next j
            Write #1, polySym(i).style
            Write #1, polySym(i).color
            Write #1, polySym(i).Outline
            Write #1, polySym(i).OutlineColor
            Write #1, polySym(i).Size
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    If (cirindex > 0) Then
      Write #1, "CIRCLE GRAPHICS"
      Write #1, cirindex
      For i = 0 To cirindex - 1
        Write #1, i
        If (Not cirGraphic(i) Is Nothing) Then
            Write #1, cirGraphic(i).Left
            Write #1, cirGraphic(i).Right
            Write #1, cirGraphic(i).Top
            Write #1, cirGraphic(i).Bottom
            Write #1, cirSym(i).style
            Write #1, cirSym(i).color
            Write #1, cirSym(i).Outline
            Write #1, cirSym(i).OutlineColor
            Write #1, cirSym(i).Size
        Else
            Write #1, "Nothing"
        End If
      Next i
    End If
    Write #1, "END GRAPHICS"
    Write #1, "END FILE"
  Close #1
  sbrStatus.Panels(3).text = "File Saved."
  
FileOpenCancel:
  Exit Sub
End Sub</P>

非常感谢！

谢谢，我正找这个呢！学习一下，然后测试！<img src="images/post/smile/dvbbs/em01.gif" />

我想问一下：textindex，pointindex，lineindex，rectindex，polyindex ,cirindex是什么，怎么定义，怎样得到值。

<P>怎么还没有人解答呢？大家要顶阿！</P>

<DIV class=quote><B>以下是引用<I>sirc_lizheng</I>在2005-10-17 15:59:47的发言：</B><BR>
<P>怎么还没有人解答呢？大家要顶阿！</P></DIV>
<P>
<P>    ReDim Preserve strGText(textindex)<BR>      ReDim Preserve textShape(textindex)<BR>      ReDim Preserve textSym(textindex)</P>
<P>这个是数组的索引啊</P>

有没有c#的啊

老大，真无私啊，mo其实还是很有用处的