怎样在ArcMAP中使用状态条与进度条

 

本例要演示的是如何使用状态条(StatusBar)与进度条(ProgressBar)。实现后的结果为在ArcMap中，状态条位于其底部，它显示ArcMAP当前状态的信息，包含进度条。 字串3

l   要点 字串1

一般情况下，通过ArcMAP的Application实例获取IstatusBar的实例,然后再通GIS过StatusBar获取IprogressBar的实例,并将IprogressBar的实例赋给IstepProgressor类型的变量。 字串4

l   程序说明

字串3

 

运行函数ShowProgress将在ArcMap的下方GPS添加一个状态条(StatusBar)和进度条(ProgressBar)。 字串8

l   代码

字串8

 

Sub ShowProgress()
    On Error GoTo err1
    Dim pDocument As IMxDocument
    Dim pMap As IMap
    Dim pLayer As ILayer
    Dim pFeatureLayer As IFeatureLayer
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeatureClass As IFeatureClass
    Dim pFeature As IFeature
    Dim dSum As Double
    Dim lFieldIndex As Long
    Dim lNumFeat As Long
    Dim dInterval As Double
    Set pDocument = Application.Document
    Set pMap = pDocument.FocusMap
    Set pLayer = pMap.Layer(0)
    Set pFeatureLayer = pLayer

字串7

    Set pFeatureClass = pFeatureLayer.FeatureClass
    Set pFeatureCursor = pFeatureLayer.Search(Nothing, True)
    Dim pStatusBar As IStatusBar
    Set pStatusBar = Application.StatusBar
    Dim pStepProgressor As IStepProgressor
    Set pStepProgressor= pStatusBar.ProgressBar
    lNumFeat = pFeatureClass.FeatureCount(Nothing)
    dInterval = lNumFeat / 100
    Set pFeature = pFeatureCursor.NextFeature
    ' 字段名"FID"用户根据实际而改变
    lFieldIndex = pFeature.Fields.FindField("FID")
    Dim PauseTime, Start, Finish, TotalTime, i
    PauseTime = 0.5
    pStepProgressor.MinRange = 1
    pStepProgressor.MaxRange = lNumFeat

字串5

    pStepProgressor.StepValue = dInterval
    For i = 1 To lNumFeat
        dSum = dSum + pFeature.Value(lFieldIndex)
        Set pFeature = Nothing
        Set pFeature = pFeatureCursor.NextFeature
        pStepProgressor.Position = i
        pStepProgressor.Message = "Reading record " & Str(i) & ". Sum =" & Str(dSum)
        pStepProgressor.Step
        pStepProgressor.Show
        Start = Timer
        Do While Timer < Start + PauseTime
            DoEvents
        Loop 字串3
    Next
    pStepProgressor.Hide
    Exit Sub
    err1:
      MsgBox Err.Description
End Sub