Newsgroup: it.comp.lang.visual-basic
Titolo: Come inserire una barra di Scorrimento/Avanzamento

Ciao, so che per voi sarà una domanda banale, ma per me non certo esperto di 
Visual Basic, risulta piuttosto complicato. Come è possibile inserire una 
barra di scorrimento, durante l'esecuzione di una macro?
Infatti questa macro puo' anche durare 1 ora per essere eseguita 
completamente e quindi una barra che mi fa capire a che punto sono arrivato 
puo' essere comoda.
In questo codice che ho fatto ho provato ad inserirla, ma non capisco perchè 
dopo un po' la barra si blocca su una percentuale.Se pero' poi interrompo la 
macro in esecuzione,a questo punto mi aggiorna la percentuale al valore 
corretto. E' come se non ce la facesse a restare al passo con i conti.
Sto lavorando con VBA.
Public Sub GetCoords_ColourAveInPoly(BaricentroGranataChiaroR As Single, 
BaricentroGranataChiaroG As Single, BaricentroGranataChiaroB As Single, 
BaricentroGranataScuroR As Single, BaricentroGranataScuroG As Single, 
BaricentroGranataScuroB As Single, BaricentroGrigioR As Single, 
BaricentroGrigioG As Single, BaricentroGrigioB As Single)
'Questa Macro permette di estrarre punti all'interno di ciascun
'edificio, calcolarne il colore medio ed in base a questo
'classificarlo nel modo voluto. Il risultato viene poi aggiunto
'nella tabella degli attributi di ciascun poligono
'Andiamo a definire le variabile ed il loro tipo
'utilizzate nel codice
Dim pMxDoc As IMxDocument
Dim pFtrCsr As IFeatureCursor
Dim pFtr As iFeature
Dim pGeom As IGeometry
Dim pEnv As IEnvelope
Dim pRelOp As IRelationalOperator
Dim pPt As IPoint
Dim dx As Double
Dim dy As Double
Dim R As Integer
Dim G As Integer
Dim b As Integer
Dim RSum As Long
Dim GSum As Long
Dim BSum As Long
Dim NumPunti As Long
Dim RAve As Integer
Dim GAve As Integer
Dim BAve As Integer
Dim RAveNorm As Single
Dim GAveNorm As Single
Dim BAveNorm As Single
Dim DistanzaGranataChiara As Single
Dim DistanzaGrigio As Single
Dim DistanzaGranataScuro As Single
Dim ColoreTetto As String
Dim RGBSomm As Single
Dim pFtrCsr2 As IFeatureCursor
Dim pFtrCls2 As IFeatureClass
Dim pFtr2 As iFeature
Dim Percent As Single
Dim PercNum As Single
Dim DifferenzaPrimoSecondo As Single
Dim pArea As IArea
'Inserimento di una barra di avanzamento
  Dim pStatusBar As IStatusBar
  Dim bar As Long
  Dim pProgbar As IStepProgressor
  Set pStatusBar = Application.StatusBar
  Set pProgbar = pStatusBar.ProgressBar
  pProgbar.Position = 0
  pStatusBar.ShowProgressBar "Stato Avanzamento...", 0, 3178, 1, True
'Queste variabili servono per definire la zona di indecisione
Dim AreaCalc As Integer
Dim PercMax As Single
Dim PercMin As Single
Dim MaxArea As Integer
'Definizione degli estremi della zona di non decisione
PercMax = 12
PercMin = 1
MaxArea = 1500
'Inizializzazione delle variabili utilizzate
RGBSomm = 0
RSum = 0
GSum = 0
BSum = 0
RAve = -1
GAve = -1
BAve = -1
NumPunti = 0
RAveNorm = 0
GAveNorm = 0
BAveNorm = 0
'Aggiungiamo il nuovo campo che conterrà il risultato della nostra stima
AggiuntaCampo "Tegolato", 30, esriFieldTypeString
Const COORD_RESOLUTION = 1 'Rappresenta tot unità dell'unità scelta per il 
layer. Se metri sono tot metri.Indica quanto fitto deve essere il passo
    Dim pFtrLyr As IFeatureLayer
    Dim pRLayer1 As IRasterLayer
    Set pPt = New Point
    Set pMxDoc = ThisDocument
    Set pFtrLyr = pMxDoc.FocusMap.Layer(0)
    Set pRLayer1 = pMxDoc.FocusMap.Layer(1)
    Dim pRLayer2 As IRasterLayer   'Questa riga è necessaria solamente se ho 
la presenza di due layer ortofoto
    Set pRLayer2 = pMxDoc.FocusMap.Layer(2)  'Questa riga è necessaria 
solamente se ho la presenza di due layer ortofoto
    Set pFtrCsr = pFtrLyr.FeatureClass.Search(Nothing, False)
    Set pFtr = pFtrCsr.NextFeature
    Set pFtrCls2 = pFtrLyr.FeatureClass
    Set pFtrCsr2 = pFtrCls2.Update(Nothing, False)
    Set pFtr2 = pFtrCsr2.NextFeature
    'Trovo la posizione del campo appena creato
    Dim i As Long
    i = pFtr2.Fields.FindField("Tegolato")
    'Iniziamo a ciclare per tutte le righe, fino a quando il puntatore alle 
righe
    'non punta ad un valore nullo e quindi esterno alla tabella degli 
attributi
    While Not pFtr Is Nothing
    While Not pFtr2 Is Nothing
    'Step di scorrimento della barra di avanzamento
    For bar = 0 To 3178
        pStatusBar.StepProgressBar
        Set pGeom = pFtr.Shape
        Set pArea = pGeom
        AreaCalc = pArea.Area
        If AreaCal >= MaxArea Then  'Superato questo valore la percentuale 
di differenza tra le distanze diventa costante
            Percent = PercMin
        Else
            Percent = (PercMin - PercMax) / MaxArea + PercMax 'Ad ogni 
passaggio a seconda del valore dell'area calcola la percentuale di 
differenza ammessa
        End If
        PercNum = 1 - (Percent * 0.01)
        Set pEnv = pGeom.Envelope
        Set pRelOp = pGeom
        'Questi due cicli for che seguono servono per continuare a estrarre 
punti che siano
        'però all'interno del poligono in quel momento considerato
        For dx = pEnv.LowerLeft.x To pEnv.UpperRight.x Step COORD_RESOLUTION
            For dy = pEnv.LowerLeft.y To pEnv.UpperRight.y Step 
COORD_RESOLUTION
                pPt.PutCoords dx, dy
                If pRelOp.Contains(pPt) Then
                    SetRgbByXY R, G, b, dx, dy, pRLayer1
                        If (R = -1 And G = -1 And b = -1) Then 'Questo if è 
utile solamente se ho due layer ortofoto
                        SetRgbByXY R, G, b, dx, dy, pRLayer2
                        End If
                    RSum = RSum + R
                    GSum = GSum + G
                    BSum = BSum + b
                    NumPunti = NumPunti + 1
                End If
            Next dy
        Next dx
        'Poichè può capitare di scegliere male il passo, per alcuni edifici 
piccoli potrei non riuscire a trovare
        'nemmeno un punto al'interno di questi. Viene fatta allora la 
verifica che almeno ci sia un punto di cui è
        'sono state calcolate le coordinate e quindi anche i valori R, G, B
        If NumPunti > 0 Then
            RAve = RSum / NumPunti
            GAve = GSum / NumPunti
            BAve = BSum / NumPunti
        'Possiamo Normalizzare gli R,G,B medi che avevamo ottenuto appena 
sopra.
            RGBSomm = RAve + GAve + BAve
            RAveNorm = RAve / (RGBSomm)
            GAveNorm = GAve / (RGBSomm)
            BAveNorm = BAve / (RGBSomm)
        'Calcoliamo le varie distanze dai baricentri
            DistanzaGranataChiara = Abs(Sqr((BaricentroGranataChiaroR - 
RAveNorm) ^ 2 + (BaricentroGranataChiaroG - GAveNorm) ^ 2 + 
(BaricentroGranataChiaroB - BAveNorm) ^ 2))
            DistanzaGranataScuro = Abs(Sqr((BaricentroGranataScuroR - 
RAveNorm) ^ 2 + (BaricentroGranataScuroG - GAveNorm) ^ 2 + 
(BaricentroGranataScuroB - BAveNorm) ^ 2))
            DistanzaGrigio = Abs(Sqr((BaricentroGrigioR - RAveNorm) ^ 2 + 
(BaricentroGrigioG - GAveNorm) ^ 2 + (BaricentroGrigioB - BAveNorm) ^ 2))
        'Inizializza il dato strutturato e vengono passate le variabili ed i
        'relativi valori, ordinandoli grazie alla InsertionSort in modo 
decrescente.
        'Nella posizione 1 troveremo la distanza più grande e nell'ultima 
posizione la
        'distanza più piccola (+ vicina)
            ReDim ordinato(0)
            InsertionSort "DistanzaGranataChiara", DistanzaGranataChiara
            InsertionSort "DistanzaGrigio", DistanzaGrigio
            InsertionSort "DistanzaGranataScuro", DistanzaGranataScuro
        'Calcoliamo il rapporto tra il valore più piccolo (+ vicino) e 
quello
        'immediatamente dopo
            DifferenzaPrimoSecondo = ordinato(3).valore / ordinato(2).valore
            If (ordinato(3).nome = "DistanzaGranataScuro" And 
ordinato(2).nome = "DistanzaGranataChiaro") Or (ordinato(2).nome = 
"DistanzaGranataScuro" And ordinato(3).nome = "DistanzaGranataChiaro") Then
                ColoreTetto = "Tetto a Tegole Indefinito"
            Else
                If DifferenzaPrimoSecondo <= PercNum Then 'Riesco a 
classificare senza problemi
                    If ordinato(3).nome = "DistanzaGranataChiara" Then
                    ColoreTetto = "Tetto a Tegole Chiare"
                    End If
                    If ordinato(3).nome = "DistanzaGranataScuro" Then
                    ColoreTetto = "Tetto a Tegole Scure"
                    End If
                    If ordinato(3).nome = "DistanzaGrigio" Then
                    ColoreTetto = "Tetto NON a Tegole"
                    End If
                Else
                'La differenza delle distanze è troppo piccolo, ho dei dubbi 
sulla classificazione
                ColoreTetto = "Non Classificato"
                End If
            End If
        Else
            MsgBox "Ci sono alcuni edifici che non hanno punti all'interno! 
Infittisci la griglia di scansione"
        Exit Sub
        End If
        pFtr2.Value(i) = ColoreTetto 'Aggiorna la riga di indice i
        pFtrCsr2.UpdateFeature pFtr2
        RSum = 0
        GSum = 0
        BSum = 0
        NumPunti = 0
        Set pFtr = pFtrCsr.NextFeature
        Set pFtr2 = pFtrCsr2.NextFeature
        Next bar 'Incremento della barra di avanzamento
    Wend
    Wend
    'Chiusura barra di avanzamento
    pStatusBar.HideProgressBar
    MsgBox "E' stato correttamente inserito il campo contenente il colore 
stimato del tetto", vbInformation, "Stima Colore Tetto"
End Sub 

 restare al passo con i conti. Sto lavorando con VBA.
Metti DoEvents dopo ogni aggiornamento della progessbar.
Attento perchè puoi ridurre le prestazioni...
Bye,
-- 
Carmine ( 
pikachu...@gmail.com
 (Togli la scritta NOSPAM) )
Webmaster di The Total Site 4 : 
http://www.thetotalsite.it
My Blog: 
http://blog.thetotalsite.it
MariokartDS Codice Amico: 532639027909 - CarmineC in MarioKartDS
Se un circuito funziona al primo tentativo è perchè il problema è molto
più nascosto e subdolo di quanto tu possa pensare...
E apparirà nel momento in cui farà il massimo danno 

 Attento perchč puoi ridurre le prestazioni...
Meglio un Progressbar.Refresh
Ciao 

 ha scritto nel messaggio 
news:447ae386$0$18284$4faf...@reader1.news.tin.it...

E dove metto questa chiamata?
nel codice che avevo postato prima
......
 NumPunti = 0
        Set pFtr = pFtrCsr.NextFeature
        Set pFtr2 = pFtrCsr2.NextFeature
        Next bar 'Incremento della barra di avanzamento
        ProgressBar.Refresh
    Wend
.......
Corretto?

    Wend
Ho provato ma non mi pare di vedere grossi miglioramenti! 

 Ho provato ma non mi pare di vedere grossi miglioramenti!
A me stupisce il solo fatto che questa roba venga compilata.
Ciao 

 ha scritto nel messaggio 
news:447af74e$0$18287$4faf...@reader1.news.tin.it...

Perchč che cosa ha di tanto brutto. Si si, la compila e funziona anche 
dignitosamente. Unico neo č la sua lentezza!