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