[VB] Cicli FOR/NEXT troppo lenti

[DanieleC88]

Come letto nel titolo, io trovo troppo lento ogni ciclo FOR/NEXT che uso, tipo quelli che analizzano immagini. Cosa posso fare per renderli più veloci ?

[misterx]

cosa vuol dire che analizzano le immagini?

[tas]

Immagino si tratti di una procedura che esegue trasformazioni su una immagine, bit per bit... se vuoi postaci il codice, ma tipicamente VB è lento per fare questo genere di cose.

[DanieleC88]

Intendo che il mio codice VB cerca il valore RGB di ogni pixel dell'immagine restituito da GetPixel attraverso l'analisi del codice esadecimale. Per "analizzare" tutta l'immagine serve molto.

[puccio078]

Il problema non è del ciclo, ma della procedura ke analizza l'immagini, cmq il ciclo for è il + veloce fra tutti i controlli iterativi, si parla di centesimi di secondo.

[cionci]

Non è che poi postare il ciclo ?
Il problema più che altro credo che sia VB che quando va a lavorare sui bit è un po' lentuccio...

[dani&l]

Originally posted by "DanieleC88"

Intendo che il mio codice VB cerca il valore RGB di ogni pixel dell'immagine restituito da GetPixel attraverso l'analisi del codice esadecimale. Per "analizzare" tutta l'immagine serve molto.

quindi molto probabilmente usi un doppio ciclo for ...next, uno x la riga e l'altro x la colonna. Ma se il lavoro che devi fare è quello di avere un valore pixel x pixel non credo ci sia altra soluzione. Al max puoi sostituirlo con un ciclo while ... wend ma credo non cambi niente.

[DanieleC88]

dani&l ha perfettamente indovinato. Qualche giorno vi manderò il codice così me lo cercate di ottimizzare.

Anzi: Le DX usano GetRed, green... ma non so come usarle, aiutatemi

[DanieleC88]

Ecco il codice:



Sub MaskPicture(picSource As PictureBox, picDest As PictureBox, ByVal MaskColor As Long, Optional ByVal Opacity As Byte = 255, Optional ByVal RefreshDestPic As Boolean = False)
Dim MSKR As Byte
Dim MSKG As Byte
Dim MSKB As Byte

Dim COLR As Byte
Dim COLG As Byte
Dim COLB As Byte

Dim OP_STEP As Single

picSource.ScaleMode = vbPixels
sWidth = picSource.ScaleWidth
sHeight = picSource.ScaleHeight
sDC = picSource.hDC

picDest.ScaleMode = vbPixels
picDest.Width = picSource.Width
picDest.Height = picSource.Height
dDC = picDest.hDC

OP_STEP = ((100 / 255) * Opacity) / 100

Call ColorGetRGB(MaskColor, MSKR, MSKG, MSKB)

DoEvents

For X = 1 To sWidth
For Y = 1 To sHeight
PIX = GetPixel(sDC, X, Y)
Call ColorGetRGB(PIX, COLR, COLG, COLB)

ADDR = COLR
ADDG = COLG
ADDB = COLB

ADDR = ((MSKR - ADDR) * OP_STEP) ' / Opacity)
ADDG = ((MSKG - ADDG) * OP_STEP) '/ Opacity)
ADDB = ((MSKB - ADDB) * OP_STEP) '/ Opacity)

COLR = NumberLimit((COLR + ADDR), 0, 255)
COLG = NumberLimit((COLG + ADDG), 0, 255)
COLB = NumberLimit((COLB + ADDB), 0, 255)

' If (COLR > 255) Then COLR = 255: If (COLR < 0) Then COLR = 0
' If (COLG > 255) Then COLG = 255: If (COLG < 0) Then COLG = 0
' If (COLB > 255) Then COLB = 255: If (COLB < 0) Then COLB = 0

SetPixel dDC, X, Y, RGB(COLR, COLG, COLB)
Next Y
Next X

If RefreshDestPic Then
picDest.Refresh
End If
End Sub

Function NumberLimit(ByVal valNumber As Single, ByVal Min As Single, ByVal Max As Single) As Single
Dim numTemp As Single

numTemp = valNumber

If (numTemp > Max) Then numTemp = Max
If (numTemp < Min) Then numTemp = Min

NumberLimit = numTemp
End Function

Sub ColorGetRGB(ByVal Color As Long, Red As Byte, Green As Byte, Blue As Byte)
HexColor = Hex(Color)
MidColor = HexColor

If ((Len(MidColor) <= 8) And (Len(MidColor) > 6)) Then
MidRed = Mid(MidColor, 7, 2)
MidGreen = Mid(MidColor, 5, 2)
MidBlue = Mid(MidColor, 3, 2)
Adding = Mid(MidColor, 1, 2)
ElseIf ((Len(MidColor) <= 6) And (Len(MidColor) > 4)) Then
MidRed = Mid(MidColor, (Len(MidColor) - 1), 2)
MidGreen = Mid(MidColor, (Len(MidColor) - 3), 2)
MidBlue = Mid(MidColor, 1, (1 + (Len(MidColor) - 5)))
ElseIf ((Len(MidColor) <= 4) And (Len(MidColor) > 2)) Then
MidRed = Mid(MidColor, (Len(MidColor) - 1), 2)
MidGreen = Mid(MidColor, 1, (1 + (Len(MidColor) - 3)))
MidBlue = 0
ElseIf (Len(MidColor) <= 2) Then
MidRed = MidColor
MidGreen = 0
MidBlue = 0
End If

Adding = Val("&H" & Adding & "&")
HexRed = Val("&H" & MidRed & "&")
HexGreen = Val("&H" & MidGreen & "&")
HexBlue = Val("&H" & MidBlue & "&")

HexRed = HexRed + Adding
HexGreen = HexGreen + Adding
HexBlue = HexBlue + Adding

If (HexRed > 255) Then HexRed = 255
If (HexGreen > 255) Then HexGreen = 255
If (HexBlue > 255) Then HexBlue = 255

Red = HexRed
Green = HexGreen
Blue = HexBlue
End Sub

[cionci]

L'unico modo è di andare ad operare sull'intero pixel invece di fare la scomposizione...
Ci sarebbe un po' da studiarci...

[DanieleC88]

Si, ci ho pensato ma non so come fare: il valore long delle immagini ha anche numeri negativi grandissimi, e mi vengono fuori overflow o simili, e comunque i colori mi escono stravolti...

[bsummer]

Hmmm, il problema dei valori negativi e' dovuto al fatto che usi tipi di dato segnati.
Se invece di un long utilizzi l'analogo non segnato il valore dato dalla tripla RGB sara' a 24 bit e non segnato.
Potresti dire quali sono le operazioni effettive che vuoi fare su ogni pixel ? (sono pigro e dal codice non c'ho capito molto :D )

Bye

[DanieleC88]

Il mio codice "mischia" un colore con un'altro, aggiungendo al colore già presente la percentuale del nuovo colore, non so se sono stato chiaro.

[bsummer]

Bene.
Innanzitutto, a parte alcune cose che si possono migliorare, c'è da dire che il vero colpevole della lentezza sono le chiamate a procedura che fai nel ciclo. A parte quelle alle funzioni create da te, ci sono quelle a GetPixel e SetPixel.
L'ideale sarebbe riuscire ad avere un riferimento diretto alla zona di memoria ove l'immagine è contenuta, ma questo non credo sia possibile in Vb.

Guardiamo le altre cose.

Intanto non capisco questa riga
"OP_STEP = ((100 / 255) * Opacity) / 100 "

Potresti scrivere direttamente OP_STEP = Opacity/255, e sarebbe equivalente ;)

Cmq, questa è fuori dal ciclo, quindi non ha particolari colpe.

La procedura "ColorGetRgb", da quanto capisco prende il colore a 24bit e ne restituisce le 3 componenti.
Considerando che il dato restituito da GetPixel sarà con buona probabilità un long (4 byte, ma noi interessano i 3 meno significativi), un possibile metodo per scomporre le componenti è questo:

Blue = (colore and &H00FF0000) / 65536
Green = (colore and &H0000FF00) / 256
Red = (colore and &H000000FF)


(Ho usato la sequenza Blue-Green-red, perchè spesso l'RgB in memoria è codificato così)
Sarebbe stato più elegante utilizzare gli shift a destra dei bit, ma in Vb non so se e come si faccia.
Non capisco bene tutto il lavoro che fai nella procedura che ti sei costruito. Se il risultato finale era solo quello di suddividere le 3 componenti allora quello che ti ho scritto ti dovrebbe bastare.

Allora, io riscriverei il for così:

for x =1 to sWidth
for y =1 to sHeight
pix = GetPixel(sDc,x,y)
colr = pix and &H000000FF
colg = (pix and &H0000FF00) /256
colb = (pix and &H000000FF) / 65536

colr = colr + (mskr-colr)*Op_Step
colb = colb + (mskb-colb)*Op_step
colg = colg + (mskg-colg)*Op_Step

if (colr<0) then
colr=0
else
colr= colr and &H00FF
end if

if (colb<0) then
colb=0
else
colb= colb and &H00FF
end if

if (colg<0) then
colg=0
else
colg= colg and &H00FF
end if
SetPixel dDc,x,y,rgb(colr,colg,colb)
next y
next x

Sostanzialmente ho condensato in un'unica riga le operazioni sulle componenti e ho rimaneggiato la funzione numberLimit con i 3 If che, anche se meno eleganti, dovrebbero fornire più velocità di esecuzione (la tua funzione faceva la stessa cosa, ma devi tenere in considerazione il tempo perso nella chiamata e nel passaggio dei parametri).
La mia unica incognita è la funzione di scomposizione delle componenti del colore: quella fatta da te mi sembra particolarmente complessa, e mi viene il dubbio quindi che non si limiti a fare solo quello. Quindi, forse ho cannato tutto :D

Boh...bye!

[cionci]

Per lavorare direttamente su un buffer ed ottenere direttamente tutti i pixel puoi usare le API GetDIBits e SetDIBits...non mi chiedete come si usano ;)

[DanieleC88]

Originally posted by "bsummer"

Sostanzialmente ho condensato in un'unica riga le operazioni sulle componenti e ho rimaneggiato la funzione numberLimit con i 3 If che, anche se meno eleganti, dovrebbero fornire più velocità di esecuzione (la tua funzione faceva la stessa cosa, ma devi tenere in considerazione il tempo perso nella chiamata e nel passaggio dei parametri).
La mia unica incognita è la funzione di scomposizione delle componenti del colore: quella fatta da te mi sembra particolarmente complessa, e mi viene il dubbio quindi che non si limiti a fare solo quello. Quindi, forse ho cannato tutto :D

Boh...bye!

Hai invece indovinato. Le mie funzioni sono un pò lente. Proverò con le tue.

Quella riga OP_STEP che non capisci mi serve per ottenere la percentuale dell'opacità che mi viene passata con un valore byte, cioè con un massimo di 255. Divido ultimamente per cento dato che i valori li moltiplico, e mi serve quindi un valore uguale o inferiore ad 1.

La mi funzione ColorGetRGB serve solo a scomporre il colore ed é articolata così perchè recupero i valore da un numero esadecimale, che a volte "sballa" i colori con altre funzioni trovate su internet, e così ho fatto la mia.

Per il resto, credo che tu abbia risolto. Ripeto: proverò e ti farò sapere.

[bsummer]

Quello che volevo dire è che se provi a controllare, noterai come "OP_STEP = ((100 / 255) * Opacity) / 100 " e "Op_STEP = Opacity/255" siano perfettamente la stessa cosa. Del resto Opacity è un valore compreso tra 0 e 255 quindi OP_STEP sarà un valore compreso tra 0 (opacity=0) e 1 (opacity=255), proprio come desideravi.

Ne approfitto per darti della altre dritte.

La procedura che ti ho scritto non aspettarti sia una scheggia... le due divisioni ad esempio (quella per 256 e quella per 65536) portano via un bel po' di tempo. Essendo tali valori potenze di 2, si sarebbe potuto semplificare le operazioni facendo degli shift a destra dei bit dei dati (256 = 2^8, shift a destra dei dati colore di 8 posizioni, 65536 = 2^16, shift a destra di 16 posizioni). Tuttavia tali operazioni non so se si possono fare in Vb. Se le trovi allora hai fatto un grosso passo in avanti in termini prestazionali.

Se invece non le trovi, quando ero piccolo :D mi hanno insegnato che la divisione è più difficile in termini computazionali della moltiplicazione. I pc non fanno eccezione, quindi invece di dividere per 256 e 65536, potremmo fare al di fuori del ciclo for il seguente assegnamento:

q1 = 1/256
q2 = 1/65536 oppure q2 = q1/256

Poi, invece di

colg = (pix and &H0000FF00) /256
colb = (pix and &H000000FF) / 65536

mettere

colg = (pix and &H0000FF00) * q1
colb = (pix and &H000000FF) * q2

Se mi posso permettere vorrei suggerirti un'altro modo di fare il blending (fusione ) dei colori.

Sia c1 il colore originale e sia c2 quello con cui lo vuoi "mischiare"

Allora il colore finale (cf) è dato da

cf = (1-op)*c1+ op*c2

Più op (opacità) è alta e più il colore originale viene "perso". Viceversa, più opacità è bassa e più il colore originale viene mantenuto.

La funzione allora diventerebbe:

q1 = 1/256
q2 = q1/256

for x =1 to sWidth
for y =1 to sHeight
pix = GetPixel(sDc,x,y)

colr = pix and &H000000FF
colg = (pix and &H0000FF00) * q1
colb = (pix and &H000000FF) * q2

op2 = (1-op_step)

colr = (op2*colr) + (mskr*Op_Step)
colb = (op2*colb) + (mskb*Op_step)
colg = (op2*colg) + (mskg*Op_Step)

' in questo modo i vari col sono sicurmente maggiori di zero e
' per via del tipo di operazione inferiori a 256. QUindi non ho bisogno
' di ulteriori controlli

SetPixel dDc,x,y,rgb(colr,colg,colb)

next y
next x

Rispetto a prima ho 3 moltiplicazioni in più per ciclo, tuttavia ho tolto gli If che avrebbero potuto creare dei branch e quindi interrompere la pipeline delle istruzioni.

Migliorare ancora ?
Beh, sostituendo le moltiplicazioni per q1 e q2 con degli shift e usando quello di cui ha accennato Cionci per accedere direttamente al buffer dell'immagine senza chiamare le funzioni get e set pixel.

Bye

[DanieleC88]

Innanzitutto grazie per avermi aiutato, bsummer, e ringrazio anche gli altri.

Poi volevo dirti che non ho avuto tempo di leggermi tutta la tua nuova risposta, lo farò con calma in seguito; per quella vecchia: il tempo di esecuzione, grazie ai tuoi metodi, é addirittura dimezzato, il problema é che la funzione da te passata per la conversione in R,G,B del valore Long mi cambia un pò tutti i colori, e così ho dovuto riusare la mia funzione, che legge i valori esadecimali e, finora, non ha mai sbagliato.
Per questo aumentano nuovamente i tempi...

Per il nuovo post: vero, OP_STEP lo potevo ottenere dividendo per 255... ma io mi sono sempre trovato a lavorare sulle percentuali diverse da un tipo preciso di numeri, e così ho riusato i miei vecchi codici.

[bsummer]

Prego :)
Per i colori sbagliati: molto probabilmente i colori vengono falsati perchè ho sbagliato l'ordine con cui estraggo le componenti rgb. Prova ad invertire colr con colb cioè scrivi...

... mmm, un attimo, mi sono appena accorto di aver fatto un errore nelle formule...io avevo scritto:

colr = pix and &H000000FF
colg = (pix and &H0000FF00) * q1
colb = (pix and &H000000FF) * q2

ma colb è sbagliato! :D Sorry

Correggilo con:

colb = (pix and &H00FF0000) * q2

Ecco così dovrebbe essere giusto.
Se tuttavia dovessero venire fuori ancora colori strani, prova ad invertire la maschera di bit usata per colr e colb, cioè scrivi:

colr = pix and &H00FF0000
colg = (pix and &H0000FF00) * q1
colb = (pix and &H000000FF) * q2

Questo perchè io ho presupposto che in memoria l'RGB sia in realtà codificato come BGR (in passato mi è capitato spesso di trovarlo così)...ma Vb potrebbe invece usare l'altra notazione.

Un'ultima cosa: il controllo picture box contiene 2 metodi che dovrebbero fare al tuo caso.

"Point(x,y)" restiruisce il colore alla posizione x,y
"PSet (x,y), colore" setta il colore alla posizione x,y

Magari lavorano piu' velocemente rispetto alle equivalenti Api.

Aloha

[cionci]

Scusate, ma non conviene mettersi tutto il bitmap sorgente in un buffer ed operare lì sopra ? Almeno di evita di fare 3 mila chiamate a funzione per recuperare e settare i pixel...

[bsummer]

Beh, penso di si... :D