clementio
Messages postés432Date d'inscriptionsamedi 18 mai 2002StatutMembreDernière intervention17 février 2014
-
23 juin 2006 à 17:12
cs_ym_trainz
Messages postés160Date d'inscriptionvendredi 27 janvier 2006StatutMembreDernière intervention21 avril 2015
-
28 sept. 2008 à 21:44
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
cs_ym_trainz
Messages postés160Date d'inscriptionvendredi 27 janvier 2006StatutMembreDernière intervention21 avril 2015 28 sept. 2008 à 21:44
Bravo Clementio !
Encore une super source !
J'ai juste rajouté un genre de ProgressBar car j'aime savoir où on en est... :
Dans form1 / Lancer , dans la boucle :
For lX = 0 To lSrcWidth Step lWidth
'*************
Counter = Counter + 1 'Counter en long
If Counter = 8000 Then
Counter = 0
tlb.Buttons(8).Caption = CStr(Int(100 * CStr(lY) / lSrcHeight)) + " %"
DoEvents
End If
'***************
Evidemment, en fin de procédure, tlb.Buttons(8).Caption = "Exécuter"
Encore merci !
Cordialement,
ym_trainz
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 1 août 2006 à 17:44
et oui ^^
_DoOmy_
Messages postés15Date d'inscriptionsamedi 19 novembre 2005StatutMembreDernière intervention17 septembre 2006 1 août 2006 à 17:33
Monstrueux, ça marche avec toutes les images?
clementio
Messages postés432Date d'inscriptionsamedi 18 mai 2002StatutMembreDernière intervention17 février 20141 27 juin 2006 à 07:21
La formule exacte est:
lVal = (lVal Mod &H100) + ((lVal \ &H100) Mod &H100) + (lVal \ &H10000)
Merci encore pour ces conseils...
J'ai mis la source à jour et modifié l'interface pour que ça fasse un peu plus "professionnel".
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 27 juin 2006 à 06:55
belle accéleration ^^
lors de la conversion NB, tu pourrais t'epargner quelques couteuses lectures de tableau, couteuses en VB :
For lY2 = 0 To lHeight - 1
For lX2 = 0 To lWidth - 1
lVal = tBitImage(lX2, lY2)
lVal = (lVal Mod &HFF) + ((lVal \ &HFF) Mod &HFF) + ((lVal \ &H10000))
(à noter que j'ai fait : lSeuil = Slider1.Value * 3)
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 27 juin 2006 à 06:35
en stockant ton tableau ainsi :
ReDim tBitCar(lWidth - 1, lHeight - 1, 32 To 255)
tu pourras faire :
'On remplit tBitCar en bouclant sur les caratères entre 32 et 255
For lCompteur = 32 To 255
'On écrit le caractère sur l'image buffer
TextOut picBuff.hdc, 0, 0, ChrW$(lCompteur), 1
'On copie la valeur des pixels dans tBitImage
GetDIBits picBuff.hdc, picBuff.Image, 0, lHeight, tBitCar(0, 0, lCompteur), bi32BitInfo, DIB_RGB_COLORS
Next
clementio
Messages postés432Date d'inscriptionsamedi 18 mai 2002StatutMembreDernière intervention17 février 20141 26 juin 2006 à 23:22
J'ai encore accélérer l'algo de traitement!!!
C'est incroyable la différence avec le début. Je pense que maintenant il sera difficile de faire plus rapide...
clementio
Messages postés432Date d'inscriptionsamedi 18 mai 2002StatutMembreDernière intervention17 février 20141 26 juin 2006 à 18:28
Je viens de mettre à jour avec les suggestions de Renfield.
Ca complique un peu le code mais le traitement est environ 3 à 4 fois plus rapide!!!!
C'est trop cool, merci à toi Renfield...
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 26 juin 2006 à 10:25
y'a quelques astuces simple a mettre en oeuvre, our accelerer la chose...
faire un :
SetBkMode picSource.hdc, OPAQUE
SetBkMode picDiff.hdc, OPAQUE
au début, par exemple (le fond du texte sera opaque, plus besoin d'effacer la zone avant un Print)
utiliser TextOut picDiff.hdc, 0, 0, ChrW$(lCompteur), 1
plutot que Print (faire un .Refresh por visualiser)
PicZone ne sert a rien...
BitBlt picDiff.hdc, 0, 0, lWidth, lHeight, picSource.hdc, lX, lY, vbSrcInvert
suffit
évite aussi les multiples allocations de sChaines (lors des concaténations)
utilises un tableau, ou définit la taille de sChaine au début :
28 sept. 2008 à 21:44
Encore une super source !
J'ai juste rajouté un genre de ProgressBar car j'aime savoir où on en est... :
Dans form1 / Lancer , dans la boucle :
For lX = 0 To lSrcWidth Step lWidth
'*************
Counter = Counter + 1 'Counter en long
If Counter = 8000 Then
Counter = 0
tlb.Buttons(8).Caption = CStr(Int(100 * CStr(lY) / lSrcHeight)) + " %"
DoEvents
End If
'***************
Evidemment, en fin de procédure, tlb.Buttons(8).Caption = "Exécuter"
Encore merci !
Cordialement,
ym_trainz
1 août 2006 à 17:44
1 août 2006 à 17:33
27 juin 2006 à 07:21
lVal = (lVal Mod &H100) + ((lVal \ &H100) Mod &H100) + (lVal \ &H10000)
Merci encore pour ces conseils...
J'ai mis la source à jour et modifié l'interface pour que ça fasse un peu plus "professionnel".
27 juin 2006 à 06:55
lors de la conversion NB, tu pourrais t'epargner quelques couteuses lectures de tableau, couteuses en VB :
For lY2 = 0 To lHeight - 1
For lX2 = 0 To lWidth - 1
lVal = tBitImage(lX2, lY2)
lVal = (lVal Mod &HFF) + ((lVal \ &HFF) Mod &HFF) + ((lVal \ &H10000))
(à noter que j'ai fait : lSeuil = Slider1.Value * 3)
27 juin 2006 à 06:35
ReDim tBitCar(lWidth - 1, lHeight - 1, 32 To 255)
tu pourras faire :
'On remplit tBitCar en bouclant sur les caratères entre 32 et 255
For lCompteur = 32 To 255
'On écrit le caractère sur l'image buffer
TextOut picBuff.hdc, 0, 0, ChrW$(lCompteur), 1
'On copie la valeur des pixels dans tBitImage
GetDIBits picBuff.hdc, picBuff.Image, 0, lHeight, tBitCar(0, 0, lCompteur), bi32BitInfo, DIB_RGB_COLORS
Next
26 juin 2006 à 23:22
C'est incroyable la différence avec le début. Je pense que maintenant il sera difficile de faire plus rapide...
26 juin 2006 à 18:28
Ca complique un peu le code mais le traitement est environ 3 à 4 fois plus rapide!!!!
C'est trop cool, merci à toi Renfield...
26 juin 2006 à 10:25
faire un :
SetBkMode picSource.hdc, OPAQUE
SetBkMode picDiff.hdc, OPAQUE
au début, par exemple (le fond du texte sera opaque, plus besoin d'effacer la zone avant un Print)
utiliser TextOut picDiff.hdc, 0, 0, ChrW$(lCompteur), 1
plutot que Print (faire un .Refresh por visualiser)
PicZone ne sert a rien...
BitBlt picDiff.hdc, 0, 0, lWidth, lHeight, picSource.hdc, lX, lY, vbSrcInvert
suffit
évite aussi les multiples allocations de sChaines (lors des concaténations)
utilises un tableau, ou définit la taille de sChaine au début :
sChaine = Space$((2 + CInt(0.5 + picSource.Width / lWidth)) * CInt(0.5 + picSource.Height / lHeight))
ensuite :
nIndex = nIndex + 1
Mid$(sChaine, nIndex) = ChrW$(lChoix)
24 juin 2006 à 18:23
24 juin 2006 à 02:21
23 juin 2006 à 23:32