Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

EFFET DE MOSAIQUE (REMPLISSAGE PAR BLOCS ALÉATOIRES) D'1 IMAGE AVEC PAINTPICTURE


Information sur la source

Catégorie :Graphique Niveau : Débutant Date de création : 12/07/2002 Date de mise à jour : 12/07/2002 00:35:54 Vu : 2 184

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (3)
Ajouter un commentaire et/ou une note

Description

Bonjour à tous, après VBA je me lance sur VB et suis en train de travailler sur un diaporama avec paintpicture. je joins ma première source...et vous demande donc d'être indulgent, elle m'as donné du mal mais vaut le détour (enfin je pense).
Le principe est sur une form avec 2 picturebox (srce et cible) et un bouton de faire apparaitre sur l'image de la picturebox cible une autre image par petites rectangles qui se disposent de façon aléatoire. J'ai galerer un moment pour essayer de combiner Rdn avec une procédure qui évite de reprendre un chiffre déjà tiré, MERCI A cawish2000 qui avait résolu le problème avant moi. Cette fonction ajouté à celle qui me permets de générer des coordonnées X et y à partir de ce nombre donne ce résultat (nota : j'ai pas programmer tous les paramètres utilisez donc 2 pictures box et 2 images srce et cible de taile identique avec autoredraw à False

 

Source

  • private sub mosaique()
  • Case "7" 'mosaïque
  • Dim block, i ,cal , valmax, flag() as integer
  • Dim sortie
  • Dim Cx 'abscisse du "block" à déssiner
  • Dim Cy 'ordonnée du "block" à dessiner
  • Dim Tl 'longueur de pciture
  • Dim Th'hauteur de picture
  • block = 100 ' dénominateur de subdivision de l'écran hauteur et longueur (libre)
  • tl = picutre1.width / block ' longueur du block
  • th = picture1.height / block 'hauteur du block
  • 'le block est donc l'unité d'affichage pour la fonction
  • valmax = block * block ' nbre de block sur l'écran
  • ReDim flag(valmax)
  • For i = 1 To valmax
  • flag(i) = 1 'attribue la valeur 1 à chaque élément du tableau x nombre de blocks
  • Next i
  • For i = 1 To valmax
  • cal = Int(Rnd() * valmax) + 1 'génère un nombre aléatoire sur la totalité des blocks et l'incrémente
  • If flag(cal) = 1 Then 'si le chiffre tiré est déjà à 1 dans le tableau
  • 'c'est à dire qu'il n'as pas déjà été tiré
  • flag(cal) = 0 'le passe à 0 pour le marquer comme tiré
  • Else ' si il est égale à 0 donc déjà tité
  • While flag(cal) = 0 'et tant qu'il est à zéro
  • cal = Int(Rnd() * valmax) + 1 ' génère un autre nombre
  • Wend 'fin de la condition
  • flag(cal) = 0 'le marque comme tiré (vous suivez ?)
  • End If
  • 'un ligne faisant 100 blocks tout block supérieur à 100 sera donc positionné à partir de la ligne "ligne1" (la première étant la ligne 0 donc ordonnée = 0
  • If cal >= block Then
  • Cy = Int(cal / (block)) 'divise par le nbre de blocks et prends la
  • ' partie entière comme n° de ligne (ordonnée)
  • Cyy = (cal / (block)) 'reprends la valeur calcué en Cy mais sans oter la partie entière "ligne"
  • Cx = (block) * (Cyy - Cy) 'multiplie le block par la partie décimale pour avoir le
  • ' positionnement en colonne (abscisse)
  • If Cx = 100 Then ' si l'abscisse = 100 soit bord droite de l'écran, la longueur avec paint
  • 'picture renverra une erreur "5"
  • Cx = 99 'décale l'abscisse à 99
  • End If
  • If Cy = 100 Then 'idem pour l'ordonnée, si on est en bas d'écran
  • 'rajouter une hauteur donnera une erreur "5"
  • Cy = 99
  • End If
  • Else 'si la valeur tirée est inférieure à 100 l'ordonnée (Cy) sera de 0
  • Cx = cal
  • Cy = 0
  • End If
  • 'dessine à l'abscisse et l'ordonnée calculé avec le nombre aléatoire un rectangle coresspondant au même'rectangle de l'image source
  • cible.PaintPicture srce.Picture, (Cx) * TL, (Cy) * TH, TL + 1, TH, (Cx) * TL, (Cy) * TH, TL, TH, vbSrcCopy
  • Next i, passe à la génération du nombre aléatoire suivant
  • end sub
private sub mosaique()

Case "7" 'mosaïque
Dim block, i ,cal , valmax, flag() as integer
Dim sortie
Dim Cx 'abscisse du "block" à déssiner
Dim Cy 'ordonnée du "block" à dessiner
Dim Tl 'longueur de pciture
Dim Th'hauteur de picture

block = 100 ' dénominateur de subdivision de l'écran hauteur et longueur (libre)
tl = picutre1.width / block ' longueur du block
th = picture1.height / block 'hauteur du block
'le block est donc l'unité d'affichage pour la fonction

valmax = block * block ' nbre de block sur l'écran
ReDim flag(valmax)
For i = 1 To valmax
        flag(i) = 1 'attribue la valeur 1 à chaque élément du tableau x nombre de blocks
Next i

For i = 1 To valmax
cal = Int(Rnd() * valmax) + 1 'génère un nombre aléatoire sur la totalité des blocks et l'incrémente 
                    If flag(cal) = 1 Then 'si le chiffre tiré est déjà à 1 dans le tableau 
	                                      'c'est à dire qu'il n'as pas déjà été tiré
                            flag(cal) = 0 'le passe à 0 pour le marquer comme tiré
                      Else ' si il est égale à 0 donc déjà tité
                    	While flag(cal) = 0 'et tant qu'il est à zéro
                    	cal = Int(Rnd() * valmax) + 1  ' génère un autre nombre
                    Wend 'fin de la condition
                             flag(cal) = 0 'le marque comme tiré (vous suivez ?)
                     End If
'un ligne faisant 100 blocks tout block supérieur à 100 sera donc positionné à partir de la ligne "ligne1" (la première étant la ligne 0 donc ordonnée = 0
    If cal >= block Then
        Cy = Int(cal / (block)) 'divise par le nbre de blocks et prends la
                                              ' partie entière comme n° de ligne (ordonnée)
        Cyy = (cal / (block)) 'reprends la valeur calcué en Cy mais sans oter la partie entière "ligne"
         Cx = (block) * (Cyy - Cy) 'multiplie le block par la partie décimale pour avoir le
			 ' positionnement en colonne (abscisse)
        If Cx = 100 Then ' si l'abscisse = 100 soit bord droite de l'écran, la longueur avec paint
		   'picture renverra une erreur "5"	
            Cx = 99           'décale l'abscisse à 99
        End If
        If Cy = 100 Then 'idem pour l'ordonnée, si on est en bas d'écran
		'rajouter une hauteur donnera une erreur "5"
        Cy = 99
        End If
    Else   'si la valeur tirée est inférieure à 100 l'ordonnée (Cy) sera de 0 
        Cx = cal
        Cy = 0
    End If
'dessine à l'abscisse et l'ordonnée calculé avec le nombre aléatoire un rectangle coresspondant au même'rectangle de l'image source
        cible.PaintPicture srce.Picture, (Cx) * TL, (Cy) * TH, TL + 1, TH, (Cx) * TL, (Cy) * TH, TL, TH, vbSrcCopy

Next i, passe à la génération du nombre aléatoire suivant

end sub

Conclusion

Si vous trouvez ça intéressant merci de votre note généreuse
 

Commentaires et avis

signaler à un administrateur
Commentaire de neo12 le 12/07/2002 00:45:07

oups, j'ai trop étendu ma sélection, le Case "7" n'a rien à faire là ! de même j'ai oublié le Dim Cyy
bonprog.

signaler à un administrateur
Commentaire de Tidus le 12/07/2002 13:59:25

Une capture d'écran aurait été la bien venue ...

signaler à un administrateur
Commentaire de neo12 le 12/07/2002 15:12:34

pas possible, dans mon appli ça se lance en plein ecran et la capture d'écran ne marche pas pendant le déroulement de la fonction, si je fais une capture ça me prends l'écran précédent, juste avant l'apparition de l'image...bizarre :-(
Mais des petits rectangles de la nouvelle image apparaissent de façon aléatoire sur l'écran jusqu'à le remplir.

Ajouter un commentaire



Nos sponsors

Sondage...

CalendriCode

Décembre 2008
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
293031    

Consulter la suite du CalendriCode



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,796 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.