[Digressions] Shapes your booty, Fractales et consorts...

[Dranreb]

Pfff !
J'ai rien de simple à adapter sous la main. Il va falloir procéder par étape

 

[Staple1600]

@Dranreb

Le code VBA précédemment soumis est suffisamment simple pour un exemple, non ?

Il suffit de lancer Dessiner_Julia dans un classeur vierge.

J'ai mis le lien vers le classeur car vous vouliez un classeur.
(Classeur dont je ne suis pas l'auteur)

 

[Dranreb]

Oui, oui, je n'en ai pas eu besoin car j'ai fait comme suggéré, j'ai copié le code dans un nouveau classeur.
Rest à collecter les bouts de codes qui vont bien pour la production de fichier image.bmp, à palette et à calculer la coordonnée dans le plan complexe correspondant aux indices d'un pixel dans le tableau des valeurs. Un gros travail.

 

[Staple1600]

Re

@Dranreb
Merci pour votre intérêt.
Je vous laisse mobiliser vos compétences que je n'ai pas pour le module réservé à l'export BMP.
Si vous avez dans votre besace un code VBA pour "calculer" une fractale dans des arrays sans passer par une écriture dans les cellules, n'hésitez pas à nous la faire connaitre.

Car avec mes 6Go d RAM, Excel 365 a parfois du mal avec les fractales.

 

[Dranreb]

Le voilà complet, avec des couleurs un peu similaires.
Il ne reste qu'à trouver la partie agrandie de l'autre feuille.

 

[Staple1600]

Bonsoir @Dranreb

Je viens de tester votre fichier
1) j'ai adapté le chemin dans RéfFic
2) J'ai supprimé l'image présente
Puis j'ai appuyé sur Go

J'obtiens un fichier Travail.bmp noir dans sa totalité.

 

[Dranreb]

Mouais. Exécute un coup la macro ÉcrirePalette
Normalement elle devrait être exécutée quand on efface le chemin et qu'on clique sur Go, parce qu'il demande à définir le chemin et lance ce calcul de palette. Mais j'ai aussi eu des couac au démarrage.
D'ailleurs ne faudrait-il pas prévoir quelque chose pour définir la palette ?

 

[Staple1600]

@Dranreb


Très impressionnant!!!

Est-ce compliqué pour implémenter un choix des couleurs ?
(en mettant des valeurs RGB dans des cellules par exemple)

 

[Dranreb]

Je travaille dessus.
On les définirait par pas de 15, ce qui en ferait 18 à spécifier, les intermédiaires étant calculées par splines cubiques, mais elles serait spécifiées sous forme E, A et F plutôt.

 

[Staple1600]

@Dranreb

Merci beaucoup en tout cas pour ce magnifique ouvrage
car depuis tout à l'heure, je varie à l'envie les valeurs en E4 et G4.

 

[Dranreb]

Il pourrait être intéressant comme guide de mettre quelque part :

=MandJulia(RJul;IJul;RJul;IJul;1000)

Çà donnerait la valeur de l'ensemble de MandelBrot à cette coordonnée.
Ça aurait d'autant plus de chance d'être intéressant que la valeur serait élevée sans toutefois atteindre la limite spécifiée en dernier paramètre.

 

[Staple1600]

@Dranreb

Pour le moment, je teste les différentes valeurs que l'on peut voir sur cette image

Puis" je joue" ensuite avec ces valeurs jusqu'à obtenir des images qui me tapent dans l'oeil

 

[Dranreb]

J'ai enfin réussi à faire quelque chose pour la palette.
Il reste un autre problème que je ne sais pas encore comment paramétrer: il n'est pas souhaitable que ces index de palette soient appliqués linéairement : Au début, avec la palette qui se terminait par du vert j'ai longtemps cru à un bogue dans la façon de la calculer car il n'y avait qu'un tout petit nombre de pixels verts très disséminés …

 

[Staple1600]

Pendant que vous travaillez sur la palette, j'ai suivi
votre conseil du message#116

Et je me suis permis de faire ceci

Option Explicit
Sub Go()
Application.ScreenUpdating = False
Dim TBrut() As Integer, TMap() As Byte, Larg&, Haut&, XBm&, YBm&, EchPix#, DécalX#, DécalY#, X0#, Y0#, RJul#, IJul#, N%, NMax%, NMin%
     With ActiveSheet
         Larg = .[Larg].Value
         Haut = .[Haut].Value
         RJul = .[RJul].Value
         IJul = .[IJul].Value
         X0 = .[OrigX].Value
         Y0 = .[OrigY].Value
         EchPix = .[EchPix].Value
    End With
DécalX = X0 - EchPix * (Larg + 1) / 2
DécalY = Y0 - EchPix * (Haut + 1) / 2

ReDim TBrut(1 To Larg, 1 To Haut), TMap(1 To Larg, 1 To Haut)
NMin = &H7FFF
For XBm = 1 To Larg: For YBm = 1 To Haut
   N = MandJulia(XBm * EchPix + DécalX, YBm * EchPix + DécalY, RJul, IJul)
   TBrut(XBm, YBm) = N
   If NMin > N Then NMin = N
   If NMax < N Then NMax = N
   Next YBm, XBm
For XBm = 1 To Larg: For YBm = 1 To Haut
   TMap(XBm, YBm) = Int(IntpoHyp(TBrut(XBm, YBm), NMin, 0, NMax * 15 / 16, 254, NMax, 255) + 0.5)
   Next YBm, XBm
LancÉcriture
ÉcrireMap TMap
AfficherImage
End Sub
Function MandJulia(ByVal X As Double, ByVal Y As Double, _
                    ByVal XRf As Double, ByVal YRf As Double, _
                    Optional ByVal MaxItér As Integer = 750) As Integer
Dim NIter%, X2 As Double, Y2 As Double
For MandJulia = 0 To MaxItér - 1
X2 = X * X: Y2 = Y * Y: If X2 + Y2 > 4 Then Exit Function
Y = 2 * X * Y + YRf: X = X2 - Y2 + XRf
Next MandJulia
End Function

J'ai constaté un ralentissement
Est-ce du au fait d'utiliser les "raccourcis" pour déclarer les variables ?
L'utilisation d'un With/End With ou le passage de MaxItér de 500 à 750 ?

NB: Je m'empresse de regarder votre nouveau classeur.

 

[Dranreb]

Ah c'est plutôt l'augmentation du nombre limite d'itérations, surtout s'il se trouve que beaucoup de points y vont …