Fractalis v4.0.*
Table des procédures 1 - AssemblyInfo.vb 2 - ClsFract.vb 2.1 - Private Sub InitCoordFract 2.2 - Protected Function iCompterIterations% 2.3 - Protected Function kcCouleurPalette 2.4 - Protected Overridable Sub InitialiserTracerFract 2.5 - Protected Overridable Sub TracerFract 2.6 - Protected Sub InitCoordFract 2.7 - Public Function aptLirePoint 2.8 - Public Property bEffacerImg 2.9 - Public Property bJulia 2.10 - Public Property bModeDetailIterations 2.11 - Public Property bQuitterTrace 2.12 - Public Property iDegre% 2.13 - Public Property iNbIterationsMaxDepart% 2.14 - Public Property ptfJulia 2.15 - Public Property szTailleEcran 2.16 - Public ReadOnly Property rAmplitX 2.17 - Public ReadOnly Property rCentreX 2.18 - Public ReadOnly Property rCentreY 2.19 - Public Sub AjouterPointDetailIterations 2.20 - Public Sub Initialiser 2.21 - Public Sub InitialiserIterations 2.22 - Public Sub InitialiserPrmFract 2.23 - Public Sub RespecterRatioZoneAbs 2.24 - Public Sub SelectionnerPoint 2.25 - Public Sub TracerFractProgressif 2.26 - Public Sub ZoomerMoins 2.27 - Public Sub ZoomerZonePixels 2.28 - Public WriteOnly Property Gr 3 - ClsFractRemplissage.vb 3.1 - Private Function bRemplissage 3.2 - Protected Overrides Sub InitialiserTracerFract 3.3 - Protected Overrides Sub TracerFract 3.4 - Public Function bEmpiler 3.5 - Public Function bParcourirPile 3.6 - Public Function ptLirePt 3.7 - Public Sub Initialiser 3.8 - Public Sub New 4 - FrmConfig.vb 4.1 - <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent 4.2 - Private Function bConvTxtToSng 4.3 - Private Sub chkDetailIterations_CheckedChanged 4.4 - Private Sub cmdAppliquer_Click 4.5 - Private Sub cmdPause_Click 4.6 - Private Sub cmdStop_Click 4.7 - Private Sub cmdZoomInit_Click 4.8 - Private Sub cmdZoomMoins_Click 4.9 - Private Sub FrmConfig_Closing 4.10 - Private Sub MajTxtJulia 4.11 - Private Sub pbPrmJulia_MouseDown 4.12 - Private Sub pbxJulia_Paint 4.13 - Private Sub rbJulia_CheckedChanged 4.14 - Private Sub txtJuliaX_TextChanged 4.15 - Private Sub txtJuliaY_TextChanged 4.16 - Protected Overloads Overrides Sub Dispose 4.17 - Public Property bEffacerImg 4.18 - Public Property bJulia 4.19 - Public Property iDegre% 4.20 - Public Property iNbIterationsMax 4.21 - Public Property ptfJulia 4.22 - Public ReadOnly Property bModeDetailIterations 4.23 - Public Sub New 4.24 - Public WriteOnly Property iAvancement% 4.25 - Public WriteOnly Property sCoordZoom$ 5 - FrmFract.vb 5.1 - <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent 5.2 - Private Function bIconisation 5.3 - Private Function rectNormaliserRectangle 5.4 - Private Function rectRespecterRatioZonePixels 5.5 - Private Function rectTracerSelection 5.6 - Private Sub frmFractalis_Activated 5.7 - Private Sub frmFractalis_Closing 5.8 - Private Sub frmFractalis_Load 5.9 - Private Sub frmFractalis_MouseDown 5.10 - Private Sub frmFractalis_MouseMove 5.11 - Private Sub frmFractalis_MouseUp 5.12 - Private Sub frmFractalis_Paint 5.13 - Private Sub frmFractalis_Resize 5.14 - Private Sub InitialiserGraphique 5.15 - Private Sub m_clsFract_EvDetailIterations 5.16 - Private Sub m_clsFract_EvFinTrace 5.17 - Private Sub m_clsFract_EvMajAvancement 5.18 - Private Sub m_clsFract_EvMajBmp 5.19 - Private Sub m_frmConfig_EvAppliquer 5.20 - Private Sub m_frmConfig_EvDetailIterations 5.21 - Private Sub m_frmConfig_EvPause 5.22 - Private Sub m_frmConfig_EvStop 5.23 - Private Sub m_frmConfig_EvZoomInit 5.24 - Private Sub m_frmConfig_EvZoomMoins 5.25 - Private Sub MajCoordZoom 5.26 - Private Sub MajEcranBmpCache 5.27 - Private Sub TimerResize_Tick 5.28 - Protected Overloads Overrides Sub Dispose 5.29 - Public Function bTraceEnCours 5.30 - Public Sub LireConfig 5.31 - Public Sub New 5.32 - Public Sub PauseReprendreTrace 5.33 - Public Sub Retracer 5.34 - Public Sub StopTrace AssemblyInfo.vb ' Fichier AssemblyInfo.vb ' ----------------------- Imports System.Reflection Imports System.Runtime.InteropServices ' General Information about an assembly is controlled through the following ' set of attributes. Change these attribute values to modify the information ' associated with an assembly. ' Review the values of the assembly attributes <Assembly: AssemblyTitle("Fractalis")> <Assembly: AssemblyDescription( _ "Traceur de fractales de type Mandelbrot et Julia en VB .NET")> <Assembly: AssemblyCompany("ORS Production")> <Assembly: AssemblyProduct("Fractalis")> <Assembly: AssemblyCopyright("2003 Par Patrice Dargenton")> <Assembly: AssemblyTrademark("Fractalis")> <Assembly: AssemblyCulture("")> ' Version information for an assembly consists of the following four values: ' ' Major Version ' Minor Version ' Build Number ' Revision ' ' You can specify all the values or you can default the Build and Revision Numbers ' by using the '*' as shown below: <Assembly: AssemblyVersion("4.0.*")> ClsFract.vb ' Fichier ClsFract.vb ' ------------------- Option Strict On Option Explicit On Namespace Fractalis Public Class ClsFract #Region "Déclarations" ' Gestion des événements qui seront récupérés depuis la feuille principale ' (cela évite la méthode bourrine consistant à passer la feuille principale ' en propriété et à appeler directement ses méthodes :-) Public Event EvMajBmp() Public Event EvMajAvancement(ByVal iAvancement%) Public Event EvFinTrace() Public Event EvDetailIterations(ByVal aPt() As Point) Protected m_bModeDetailIterations As Boolean Protected m_bEffacerImg As Boolean Private m_szTailleEcran As New Size() ' Dimension du tracé en pixels Protected m_bQuitterTrace As Boolean ' Pour quitter + vite le thread Protected m_gr As Graphics ' Graphique de tracé dans le bitmap de cache Protected Const iIntegerMax% = System.Int32.MaxValue ' = 2147483647 ' Constantes par défaut Public Const bEffacerImgDef As Boolean = True ' En mode Strict On, As doit être utilisé 'Public Const typeFractDef = TFractal.Mandelbrot Public Const typeFractDef As TFractal = TFractal.Mandelbrot Public Const iDegreAlgoDef% = 2 ' Z -> Z^2 + C par défaut ' Shared : les instances de classe constantes doivent être partagées Public Shared ptfJuliaDef As PointF = New PointF(0, 1.95) ' Zoom par défaut en coordonnées absolues ' cercle entier visible à l'écran : rZoomDef = 2 Private Const rZoomDef As Decimal = 2 ' Pour un zoom arrière, on multiplie par 2 l'amplitude actuelle ' en coord. abs de l'image Private Const rFacteurZoomMoins As Decimal = 2 Protected Const iPasMax% = 32 ' Pavé de 32x32 pixels Protected Const iPasMin% = 1 ' 1 pixel ' Par convention, 1 est le code d'un pixel frontière : NbItérations max. Protected Const iCodePixelFrontiere% = 1 ' Couleur min. et max. de la palette par défaut Private Const iCouleurMin% = KnownColor.ActiveBorder ' = 1 Private Const iCouleurMax% = KnownColor.YellowGreen ' = 167 ' Commencer le modulo par la 8ème couleur Private Const iPremCouleur% = 8 Public Const iNbIterationsMaxDepartDef% = iCouleurMax - iCouleurMin Protected m_remplissage As New SolidBrush(Color.Black) Public Enum TFractal ' Types d'ensemble fractal Mandelbrot Julia End Enum Protected Structure TPrmFract ' Paramètres de tracé Dim iDegre% ' Degré de l'équation Z -> Z^Degré + C Dim iNbIterationsMaxDepart% ' Itérations max. au départ du zoom Dim typeFract As TFractal ' Type Mandelbrot ou Julia ' Pour les ensembles de Julia : Parties réelle et imag. du complexe Z Dim rRe, rIm As Decimal End Structure Protected m_prm As TPrmFract Protected m_iNbIterationsMin% ' Itérations min. constatés après un tracé Protected m_iNbIterationsMax% ' Itérations max. pour un tracé Protected Structure TCoordFract ' Structure pour les coordonnées fractales ' Coordonnées absolues dans l'ensemble de Mandelbrot ou Julia ' Un rectangle serait bien, mais il n'y a pas de constructeur ' en Decimal, seulement en Single : RectangleF ' (on a besoin de Decimal pour zoomer à fond) Dim rCoordAbsXMin, rCoordAbsXMax As Decimal Dim rCoordAbsYMin, rCoordAbsYMax As Decimal Dim rXAbs, rYAbs As Decimal Dim iPaveMaxX%, iPaveMaxY% ' Indices max. des pavés droite et bas Dim iMargeX%, iMargeY% Dim rLargPaveAbs As Decimal Dim rHautPaveAbs As Decimal End Structure Protected m_cf As TCoordFract ' La fonction Beep() standard de .NET est totalement inaudible, ' celle-ci marche, mais elle n'est pas .NET : 'Public Declare Function Beep% Lib "kernel32" ( _ ' ByVal dwFreq%, ByVal dwDuration%) ' Classe pour gérer l'affichage du détail des itérations ' de l'équation sur un pixel Private Class ClsDetailIterations Private m_iNbPts% Private m_aPt() As Point Public Sub Initialiser() m_iNbPts = 0 End Sub Public Sub AjouterPointDetailIterations( _ ByVal a As Decimal, ByVal b As Decimal, _ ByRef cf As TCoordFract) If cf.rLargPaveAbs = 0 Or cf.rHautPaveAbs = 0 Then Exit Sub Dim pt As Point pt.X = CInt(cf.iMargeX + iPasMin * (a - cf.rCoordAbsXMin) / _ cf.rLargPaveAbs + iPasMin \ 2) pt.Y = CInt(cf.iMargeY + iPasMin * (b - cf.rCoordAbsYMin) / _ cf.rHautPaveAbs + iPasMin \ 2) ReDim Preserve m_aPt(m_iNbPts) m_aPt(m_iNbPts) = pt m_iNbPts += 1 End Sub Public Function aptLirePoint() As Point() aptLirePoint = m_aPt End Function End Class Private m_oDetailIter As New ClsDetailIterations() #End Region #Region "Propriétés" Public Property szTailleEcran() As Size Get szTailleEcran = m_szTailleEcran End Get Set(ByVal szVal As Size) m_szTailleEcran = szVal End Set End Property Public WriteOnly Property Gr() As Graphics Set(ByVal gr As Graphics) m_gr = gr ' Pas de différence constatée m_gr.SmoothingMode = Drawing2D.SmoothingMode.HighSpeed m_gr.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighSpeed 'm_gr.QualityMode = Drawing2D.QualityMode.Low ' Non trouvé ? End Set End Property Public Property bQuitterTrace() As Boolean Get bQuitterTrace = m_bQuitterTrace End Get Set(ByVal bVal As Boolean) m_bQuitterTrace = bVal End Set End Property Public Property bJulia() As Boolean Get bJulia = (m_prm.typeFract = TFractal.Julia) End Get Set(ByVal bVal As Boolean) m_prm.typeFract = TFractal.Mandelbrot If bVal Then m_prm.typeFract = TFractal.Julia End Set End Property Public Property ptfJulia() As PointF Get ptfJulia.X = m_prm.rRe ptfJulia.Y = m_prm.rIm End Get Set(ByVal ptf As PointF) m_prm.rRe = CDec(ptf.X) m_prm.rIm = CDec(ptf.Y) End Set End Property Public Property iDegre%() Get iDegre = m_prm.iDegre End Get Set(ByVal iVal%) m_prm.iDegre = iVal End Set End Property Public Property iNbIterationsMaxDepart%() Get iNbIterationsMaxDepart = m_prm.iNbIterationsMaxDepart End Get Set(ByVal iVal%) m_prm.iNbIterationsMaxDepart = iVal End Set End Property Public Property bModeDetailIterations() As Boolean Get bModeDetailIterations = m_bModeDetailIterations End Get Set(ByVal bVal As Boolean) m_bModeDetailIterations = bVal End Set End Property Public Property bEffacerImg() As Boolean Get bEffacerImg = m_bEffacerImg End Get Set(ByVal bVal As Boolean) m_bEffacerImg = bVal End Set End Property Public ReadOnly Property rCentreX() As Decimal Get rCentreX = (m_cf.rCoordAbsXMax + m_cf.rCoordAbsXMin) / 2 End Get End Property Public ReadOnly Property rCentreY() As Decimal Get rCentreY = (m_cf.rCoordAbsYMax + m_cf.rCoordAbsYMin) / 2 End Get End Property Public ReadOnly Property rAmplitX() As Decimal Get rAmplitX = m_cf.rCoordAbsXMax - m_cf.rCoordAbsXMin End Get End Property #End Region #Region "Tracé des images fractales" Public Sub InitialiserPrmFract() m_cf.rCoordAbsXMin = -rZoomDef : m_cf.rCoordAbsXMax = rZoomDef m_cf.rCoordAbsYMin = -rZoomDef : m_cf.rCoordAbsYMax = rZoomDef RespecterRatioZoneAbs() m_prm.typeFract = typeFractDef m_prm.rRe = CDec(ptfJuliaDef.X) m_prm.rIm = CDec(ptfJuliaDef.Y) m_prm.iDegre = iDegreAlgoDef m_prm.iNbIterationsMaxDepart = iNbIterationsMaxDepartDef m_iNbIterationsMin = 0 m_bEffacerImg = bEffacerImgDef End Sub Public Sub InitialiserIterations() m_iNbIterationsMin = 0 End Sub Public Sub RespecterRatioZoneAbs() ' Attention : il faut conserver le ratio quelque soit celui de l'écran If m_szTailleEcran.Height >= m_szTailleEcran.Width Then If m_szTailleEcran.Width <> 0 Then _ m_cf.rCoordAbsYMax = m_cf.rCoordAbsYMin + _ (m_cf.rCoordAbsXMax - m_cf.rCoordAbsXMin) * _ m_szTailleEcran.Height / m_szTailleEcran.Width Else If m_szTailleEcran.Height <> 0 Then _ m_cf.rCoordAbsXMax = m_cf.rCoordAbsXMin + _ (m_cf.rCoordAbsYMax - m_cf.rCoordAbsYMin) * _ m_szTailleEcran.Width / m_szTailleEcran.Height End If End Sub Public Sub ZoomerZonePixels(ByVal m_rectCoordPixels As Rectangle) ' Calcul des nouvelles coordonnées absolues Dim rNewCoordAbsXMin As Decimal = _ CDec(m_rectCoordPixels.Left / m_szTailleEcran.Width) Dim rNewCoordAbsYMin As Decimal = _ CDec(m_rectCoordPixels.Top / m_szTailleEcran.Height) Dim rNewCoordAbsXMax As Decimal = _ CDec((m_rectCoordPixels.Left + m_rectCoordPixels.Width) / _ m_szTailleEcran.Width) Dim rNewCoordAbsYMax As Decimal = _ CDec((m_rectCoordPixels.Top + m_rectCoordPixels.Height) / _ m_szTailleEcran.Height) ' Ancienne amplitude absolue Dim rAncAmplitX As Decimal = m_cf.rCoordAbsXMax - m_cf.rCoordAbsXMin Dim rAncAmplitY As Decimal = m_cf.rCoordAbsYMax - m_cf.rCoordAbsYMin m_cf.rCoordAbsXMax = m_cf.rCoordAbsXMin + rNewCoordAbsXMax * rAncAmplitX m_cf.rCoordAbsYMax = m_cf.rCoordAbsYMin + rNewCoordAbsYMax * rAncAmplitY m_cf.rCoordAbsXMin = m_cf.rCoordAbsXMin + rNewCoordAbsXMin * rAncAmplitX m_cf.rCoordAbsYMin = m_cf.rCoordAbsYMin + rNewCoordAbsYMin * rAncAmplitY RespecterRatioZoneAbs() End Sub Public Sub ZoomerMoins() ' Centre du zoom Dim rCentreX As Decimal = (m_cf.rCoordAbsXMax + m_cf.rCoordAbsXMin) / 2 Dim rCentreY As Decimal = (m_cf.rCoordAbsYMax + m_cf.rCoordAbsYMin) / 2 ' Amplitude actuelle du zoom Dim rAmplitX As Decimal = m_cf.rCoordAbsXMax - m_cf.rCoordAbsXMin Dim rAmplitY As Decimal = m_cf.rCoordAbsYMax - m_cf.rCoordAbsYMin ' Reculer le zoom m_cf.rCoordAbsXMin = rCentreX - rAmplitX * rFacteurZoomMoins / 2 m_cf.rCoordAbsXMax = rCentreX + rAmplitX * rFacteurZoomMoins / 2 m_cf.rCoordAbsYMin = rCentreY - rAmplitY * rFacteurZoomMoins / 2 m_cf.rCoordAbsYMax = rCentreY + rAmplitY * rFacteurZoomMoins / 2 End Sub Public Sub TracerFractProgressif() m_bQuitterTrace = False m_bModeDetailIterations = False ' iNbIterationsMax dépend du nombre d'itérations min. précédant : ' cela évite de le définir trop élevé dès le début, alors que ' c'est seulement pour un zoom profond que l'on a besoin de ' beaucoup d'itérations If m_iNbIterationsMin < iIntegerMax Then _ m_iNbIterationsMax = _ m_prm.iNbIterationsMaxDepart + m_iNbIterationsMin m_iNbIterationsMin = iIntegerMax InitialiserTracerFract() m_gr.Clear(Color.Cyan) RaiseEvent EvMajBmp() Dim iPas% = iPasMax Do InitCoordFract(iPas) ' Pour cacher les gros pixels hors zone If m_bEffacerImg Then m_gr.Clear(Color.Cyan) TracerFract(iPas) If m_bQuitterTrace Then GoTo Fin RaiseEvent EvMajBmp() iPas \= 2 ' \ : Antislash = Division entière Loop While iPas >= iPasMin Fin: RaiseEvent EvFinTrace() 'If Not m_bQuitterTrace Then Beep(600, 20) End Sub Protected Overridable Sub InitialiserTracerFract() ' Utile pour initialiser les classes dérivées End Sub Protected Overridable Sub TracerFract(ByVal iPas%) Dim iPaveX%, iPaveY%, iNbIterations% Dim iPas0% = iPas '- 1 pour debug Dim penPixel As New Pen(Color.Black, 1) For iPaveY = 0 To m_cf.iPaveMaxY m_cf.rYAbs = (iPaveY + 0.5D) * m_cf.rHautPaveAbs + _ m_cf.rCoordAbsYMin For iPaveX = 0 To m_cf.iPaveMaxX m_cf.rXAbs = (iPaveX + 0.5D) * m_cf.rLargPaveAbs + _ m_cf.rCoordAbsXMin iNbIterations = iCompterIterations(m_cf.rXAbs, m_cf.rYAbs) ' Si le pavé est de 1 pixel, un PixelSet (PSet) serait plus rapide ' qu'un Rectangle plein, mais PixelSet n'existe pas en VB .Net : ' il est probablement implémenté dans FillRectangle() If iPas > 1 Then m_remplissage.Color = Color.FromKnownColor( _ kcCouleurPalette(iNbIterations)) m_gr.FillRectangle(m_remplissage, _ m_cf.iMargeX + iPaveX * iPas, _ m_cf.iMargeY + iPaveY * iPas, iPas0, iPas0) Else ' Pas de gain de temps constaté penPixel.Color = Color.FromKnownColor( _ kcCouleurPalette(iNbIterations)) m_gr.DrawLine(penPixel, _ m_cf.iMargeX + iPaveX, m_cf.iMargeY + iPaveY, _ m_cf.iMargeX + iPaveX + 1, m_cf.iMargeY + iPaveY) End If If m_bQuitterTrace Then Exit Sub Next iPaveX If m_szTailleEcran.Height > 1 Then _ RaiseEvent EvMajAvancement(CInt(100 * iPaveY / _ (m_szTailleEcran.Height - 1))) RaiseEvent EvMajBmp() Next iPaveY End Sub Protected Function kcCouleurPalette(ByVal iNbIterations%) As _ Drawing.KnownColor ' Détermination de la couleur de la palette standard ' à partir du modulo iCouleurMax kcCouleurPalette = CType(iCouleurMin + (iNbIterations - _ iCouleurMin + iPremCouleur) Mod iCouleurMax, Drawing.KnownColor) End Function Public Sub SelectionnerPoint(ByVal pt As Point) InitCoordFract(iPasMin, pt) iCompterIterations(m_cf.rXAbs, m_cf.rYAbs) RaiseEvent EvDetailIterations(m_oDetailIter.aptLirePoint) End Sub Private Sub InitCoordFract(ByVal iPas%, ByVal pt As Point) InitCoordFract(iPas) m_cf.rXAbs = (pt.X \ iPas) * m_cf.rLargPaveAbs + m_cf.rCoordAbsXMin m_cf.rYAbs = (pt.Y \ iPas) * m_cf.rHautPaveAbs + m_cf.rCoordAbsYMin End Sub Protected Sub InitCoordFract(ByVal iPas%) m_cf.iPaveMaxX = m_szTailleEcran.Width \ iPas - 1 m_cf.iPaveMaxY = m_szTailleEcran.Height \ iPas - 1 m_cf.iMargeX = (m_szTailleEcran.Width - (m_cf.iPaveMaxX + 1) * iPas) \ 2 m_cf.iMargeY = (m_szTailleEcran.Height - (m_cf.iPaveMaxY + 1) * iPas) \ 2 m_cf.rLargPaveAbs = (m_cf.rCoordAbsXMax - m_cf.rCoordAbsXMin) / _ (m_cf.iPaveMaxX + 1) m_cf.rHautPaveAbs = (m_cf.rCoordAbsYMax - m_cf.rCoordAbsYMin) / _ (m_cf.iPaveMaxY + 1) End Sub ' Fonction inline (import du code de la fct dans la fct appelante) : ' pas de gain de temps significatif constaté Protected Function iCompterIterations%( _ ByVal rX As Decimal, ByVal rY As Decimal) ' Nombre complexe Z = a + ib avec i*i = -1 ' Equation : Z -> Z^degré + C Dim iNbIterations% = 0 Dim a, b, a2, b2, mem_a, mem_b As Decimal If m_prm.typeFract = TFractal.Mandelbrot Then m_prm.rRe = rX m_prm.rIm = rY a = 0D b = 0D Else ' Julia a = rX b = rY iNbIterations = 1 End If If m_bModeDetailIterations Then m_oDetailIter.Initialiser() Select Case m_prm.iDegre Case 2 Do If m_bModeDetailIterations Then _ m_oDetailIter.AjouterPointDetailIterations(a, b, m_cf) a2 = a * a b2 = b * b ' On sort du cercle unitaire If a2 + b2 > 4 Then Exit Do b = 2 * a * b + m_prm.rIm a = a2 - b2 + m_prm.rRe iNbIterations += 1 Loop While iNbIterations <= m_iNbIterationsMax Case 3 Do If m_bModeDetailIterations Then _ m_oDetailIter.AjouterPointDetailIterations(a, b, m_cf) a2 = a * a b2 = b * b If a2 + b2 > 4 Then Exit Do mem_a = a mem_b = b b = 2 * a * b a = a2 - b2 a2 = mem_a * a b2 = mem_b * b b = mem_a * b + mem_b * a + m_prm.rIm a = a2 - b2 + m_prm.rRe iNbIterations += 1 Loop While iNbIterations <= m_iNbIterationsMax Case 4 Do If m_bModeDetailIterations Then _ m_oDetailIter.AjouterPointDetailIterations(a, b, m_cf) a2 = a * a b2 = b * b If a2 + b2 > 4 Then Exit Do b = 2 * a * b a = a2 - b2 a2 = a * a b2 = b * b b = 2 * a * b + m_prm.rIm a = a2 - b2 + m_prm.rRe iNbIterations += 1 Loop While iNbIterations <= m_iNbIterationsMax Case 5 Do If m_bModeDetailIterations Then _ m_oDetailIter.AjouterPointDetailIterations(a, b, m_cf) a2 = a * a b2 = b * b If a2 + b2 > 4 Then Exit Do mem_a = a : mem_b = b b = 2 * a * b a = a2 - b2 a2 = a * a b2 = b * b b = 2 * a * b a = a2 - b2 a2 = mem_a * a b2 = mem_b * b b = mem_a * b + mem_b * a + m_prm.rIm a = a2 - b2 + m_prm.rRe iNbIterations += 1 Loop While iNbIterations <= m_iNbIterationsMax End Select ' Par convention, la couleur 1 correspond au dépassement ' de iNbIterationsMax iCompterIterations = iCodePixelFrontiere ' = 1 If iNbIterations <= m_iNbIterationsMax Then If iNbIterations < m_iNbIterationsMin Then _ m_iNbIterationsMin = iNbIterations iCompterIterations = iNbIterations + 1 End If End Function #End Region End Class End Namespace ClsFractRemplissage.vb ' Fichier ClsFractRemplissage.vb ' ------------------------------ Option Strict On Option Explicit On Namespace Fractalis Public Class ClsFractRemplissage Inherits ClsFract #Region "Déclarations" ' Shadows indique que l'on masque l'événement de la classe de base Public Shadows Event EvMajBmp() ' Définition de l'avancement du remplissage : ' on se base sur la proportion de pixels à examiner, ' proportion obtenue à la résolution précédente Public Shadows Event EvMajAvancement(ByVal iAvancement%) Private m_iNbPixels% ' Nombre de pixels examinés Private m_rTauxMaxSurfaceRemp! ' Taux max. de surface remplie ' Taux min. de surface remplie lorsque la résolution des images augmente Private m_rTauxMinSurfaceRempImages! ' Par convention, 0 est le code d'un pixel non examiné Private Const iCodePixelNonExamine% = 0 'Protected Const iCodePixelFrontiere% = 1 : défini dans la classe de base Private Const iCodePixelDessin% = 2 ' Tableau pour mémoriser les codes des pixels analysés Private m_aiCodesPixel(,) As Byte ' Structure de point optimisée pour la classe de pile suivante ' SizeOf PointShort = 4 octets soit 2 Short : ' cela permet des tailles d'image de 32768 x 32768 pixels Private Structure PointShort Dim X, Y As Short Public Sub New(ByVal iX%, ByVal iY%) X = CShort(iX) Y = CShort(iY) End Sub End Structure ' Classe pour gérer une pile de pixels ' On arrive au même résultat en utilisant une collection, ' mais c'est alors 30 fois + lent : ' Dim collec As New Collection() avec collec.Add(pt) Private Class ClsPile Private m_aptPile() As PointShort ' Pile de pixels à analyser Private m_iIndicePileMax% Private m_iIndicePileL% ' Lecture Private m_iIndicePileE% ' Ecriture Public Sub Initialiser() m_iIndicePileMax = 0 ReDim m_aptPile(m_iIndicePileMax) m_iIndicePileE = -1 m_iIndicePileL = 0 End Sub Public Function bEmpiler(ByVal iX%, ByVal iY%) As Boolean ' Si on atteint la fin de pile, on réutilise les emplacements ' au début de la pile If m_iIndicePileE + 1 = m_iIndicePileMax Then m_iIndicePileE = -1 ' Si on rattrape l'indice en lecture de la pile, ' ou bien si on dépasse l'indice max. de la pile, ' on redimmensionne la pile, et on stocke le point ' en fin de pile If m_iIndicePileE + 1 = m_iIndicePileL Or _ m_iIndicePileE + 1 > m_iIndicePileMax Then ' Augmentation dynamique de la taille de la pile Try m_iIndicePileMax += 1 ReDim Preserve m_aptPile(m_iIndicePileMax) m_aptPile(m_iIndicePileMax) = New PointShort(iX, iY) bEmpiler = True Catch bEmpiler = False ' Plus assez de mémoire vive, ça craint ! End Try Exit Function End If ' On stocke le point à l'indice en écriture m_iIndicePileE += 1 ' On veut empiler un nouveau point m_aptPile(m_iIndicePileE) = New PointShort(iX, iY) bEmpiler = True End Function Public Function ptLirePt() As PointShort ptLirePt = m_aptPile(m_iIndicePileL) End Function Public Function bParcourirPile() As Boolean ' On parcours la pile et on renvoit True si on reboucle m_iIndicePileL += 1 ' Bug corrigé : > et non >= If m_iIndicePileL > m_iIndicePileMax Then _ m_iIndicePileL = 0 : bParcourirPile = True End Function End Class #End Region #Region "Tracé des images fractales avec le remplissage" Protected Overrides Sub InitialiserTracerFract() ' Par défaut toute l'image doit être remplie m_rTauxMinSurfaceRempImages = 1 End Sub Protected Overrides Sub TracerFract(ByVal iPas%) m_rTauxMaxSurfaceRemp = 0 m_iNbPixels = 0 Dim iPaveX%, iPaveY% ReDim m_aiCodesPixel(m_cf.iPaveMaxX, m_cf.iPaveMaxY) iPaveY = 0 For iPaveX = 0 To m_cf.iPaveMaxX - 1 If m_aiCodesPixel(iPaveX, iPaveY) = iCodePixelNonExamine Then _ If Not bRemplissage(iPaveX, iPaveY, iPas) Then Exit Sub Next iPaveX iPaveX = m_cf.iPaveMaxX For iPaveY = 0 To m_cf.iPaveMaxY - 1 If m_aiCodesPixel(iPaveX, iPaveY) = iCodePixelNonExamine Then _ If Not bRemplissage(0, iPaveY, iPas) Then Exit Sub Next iPaveY iPaveY = m_cf.iPaveMaxY For iPaveX = m_cf.iPaveMaxX - 1 To 0 Step -1 If m_aiCodesPixel(iPaveX, iPaveY) = iCodePixelNonExamine Then _ If Not bRemplissage(iPaveX, iPaveY, iPas) Then Exit Sub Next iPaveX iPaveX = 0 For iPaveY = m_cf.iPaveMaxY - 1 To 0 Step -1 If m_aiCodesPixel(iPaveX, iPaveY) = iCodePixelNonExamine Then _ If Not bRemplissage(iPaveX, iPaveY, iPas) Then Exit Sub Next iPaveY If m_rTauxMaxSurfaceRemp < m_rTauxMinSurfaceRempImages Then _ m_rTauxMinSurfaceRempImages = m_rTauxMaxSurfaceRemp RaiseEvent EvMajAvancement(100) End Sub Private Function bRemplissage(ByVal iPaveX%, ByVal iPaveY%, ByVal iPas%) _ As Boolean If m_bQuitterTrace Then Exit Function If iPaveX < 0 Or iPaveX > m_cf.iPaveMaxX Or _ iPaveY < 0 Or iPaveY > m_cf.iPaveMaxY Then GoTo Echec ' On peut initialiser la pile à chaque remplissage, on est quand même sûr ' que l'on oubliera aucun pixels (car le remplissage est redondant), ' et la taille de la pile sera plus faible Dim pile As New ClsPile() pile.Initialiser() If Not pile.bEmpiler(iPaveX, iPaveY) Then GoTo Echec Dim bRestePixel As Boolean bRestePixel = False Dim pt As PointShort Dim iNbIterations% Dim iCodePixel As Byte Const bAfficherPixelsFrontiere As Boolean = False Do pt = pile.ptLirePt() iPaveX = pt.X iPaveY = pt.Y If m_aiCodesPixel(iPaveX, iPaveY) <> iCodePixelNonExamine Then _ GoTo Suite ' Pixel déjà examiné bRestePixel = True m_iNbPixels += 1 m_cf.rXAbs = (iPaveX + 0.5D) * m_cf.rLargPaveAbs + m_cf.rCoordAbsXMin m_cf.rYAbs = (iPaveY + 0.5D) * m_cf.rHautPaveAbs + m_cf.rCoordAbsYMin iNbIterations = iCompterIterations(m_cf.rXAbs, m_cf.rYAbs) If iNbIterations > iCodePixelFrontiere Then iCodePixel = iCodePixelDessin Else iCodePixel = iCodePixelFrontiere End If m_aiCodesPixel(iPaveX, iPaveY) = iCodePixel If iCodePixel = iCodePixelFrontiere And _ Not bAfficherPixelsFrontiere Then GoTo Suite m_remplissage.Color = Color.FromKnownColor( _ kcCouleurPalette(iNbIterations)) m_gr.FillRectangle(m_remplissage, _ m_cf.iMargeX + iPaveX * iPas, _ m_cf.iMargeY + iPaveY * iPas, iPas, iPas) If iCodePixel = iCodePixelFrontiere Then GoTo Suite ' Coeur de l'algorithme de remplissage If iPaveY > 0 AndAlso _ m_aiCodesPixel(iPaveX, iPaveY - 1) = iCodePixelNonExamine Then _ If Not pile.bEmpiler(iPaveX, iPaveY - 1) Then GoTo Echec If iPaveX > 0 AndAlso _ m_aiCodesPixel(iPaveX - 1, iPaveY) = iCodePixelNonExamine Then _ If Not pile.bEmpiler(iPaveX - 1, iPaveY) Then GoTo Echec If iPaveY < m_cf.iPaveMaxY AndAlso _ m_aiCodesPixel(iPaveX, iPaveY + 1) = iCodePixelNonExamine Then _ If Not pile.bEmpiler(iPaveX, iPaveY + 1) Then GoTo Echec If iPaveX < m_cf.iPaveMaxX AndAlso _ m_aiCodesPixel(iPaveX + 1, iPaveY) = iCodePixelNonExamine Then _ If Not pile.bEmpiler(iPaveX + 1, iPaveY) Then GoTo Echec Suite: If pile.bParcourirPile Then If Not bRestePixel Then Exit Do bRestePixel = False RaiseEvent EvMajBmp() If m_rTauxMinSurfaceRempImages > 0 Then Dim rTauxSurfaceRemp! = CSng(m_iNbPixels / _ ((m_cf.iPaveMaxX + 1) * (m_cf.iPaveMaxY + 1))) Dim iAv% = CInt(100 * rTauxSurfaceRemp / _ m_rTauxMinSurfaceRempImages) RaiseEvent EvMajAvancement(iAv) End If End If Loop While Not m_bQuitterTrace Dim rTauxSurfaceRempFin! = CSng(m_iNbPixels / _ ((m_cf.iPaveMaxX + 1) * (m_cf.iPaveMaxY + 1))) If rTauxSurfaceRempFin > m_rTauxMaxSurfaceRemp Then _ m_rTauxMaxSurfaceRemp = rTauxSurfaceRempFin bRemplissage = Not m_bQuitterTrace Exit Function Echec: Exit Function End Function #End Region End Class End Namespace FrmConfig.vb ' Fichier FrmConfig.vb ' -------------------- Option Strict On Option Explicit On Namespace Fractalis Public Class frmConfig ' Configuration de Fractalis Inherits Form Public Event EvZoomMoins() Public Event EvZoomInit() Public Event EvAppliquer() Public Event EvPause() Public Event EvStop() Public Event EvDetailIterations() ' Amplitude max. (en coord. absolue) que l'on peut fixer ' dans la petite fenêtre pour le paramètre de Julia Private Const iAmplitPrmJulia% = 10 Private m_ptfJulia As PointF #Region " Windows Form Designer generated code " Public Sub New() MyBase.New() 'This call is required by the Windows Form Designer. InitializeComponent() 'Add any initialization after the InitializeComponent() call End Sub 'Form overrides dispose to clean up the component list. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub 'Required by the Windows Form Designer Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Friend WithEvents GroupBox1 As System.Windows.Forms.GroupBox Friend WithEvents rbJulia As System.Windows.Forms.RadioButton Friend WithEvents rbMandelbrot As System.Windows.Forms.RadioButton Friend WithEvents nudDegre As System.Windows.Forms.NumericUpDown Friend WithEvents LblDegre As System.Windows.Forms.Label Friend WithEvents cmdPause As System.Windows.Forms.Button Friend WithEvents cmdStop As System.Windows.Forms.Button Friend WithEvents cmdAppliquer As System.Windows.Forms.Button Friend WithEvents pbAvancement As System.Windows.Forms.ProgressBar Friend WithEvents nudNbIterationsMax As System.Windows.Forms.NumericUpDown Friend WithEvents lblIterationMax As System.Windows.Forms.Label Friend WithEvents cmdZoomInit As System.Windows.Forms.Button Friend WithEvents ToolTip1 As System.Windows.Forms.ToolTip Friend WithEvents cmdZoomMoins As System.Windows.Forms.Button Friend WithEvents lblZoom As System.Windows.Forms.Label Friend WithEvents chkEffacerImg As System.Windows.Forms.CheckBox Friend WithEvents chkModeDetailIterations As System.Windows.Forms.CheckBox Friend WithEvents pbxJulia As System.Windows.Forms.PictureBox Friend WithEvents lblPrmJulia As System.Windows.Forms.Label Friend WithEvents txtJuliaX As System.Windows.Forms.TextBox Friend WithEvents txtJuliaY As System.Windows.Forms.TextBox Friend WithEvents panelJulia As System.Windows.Forms.Panel <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Me.GroupBox1 = New System.Windows.Forms.GroupBox() Me.rbJulia = New System.Windows.Forms.RadioButton() Me.rbMandelbrot = New System.Windows.Forms.RadioButton() Me.nudDegre = New System.Windows.Forms.NumericUpDown() Me.LblDegre = New System.Windows.Forms.Label() Me.cmdPause = New System.Windows.Forms.Button() Me.cmdStop = New System.Windows.Forms.Button() Me.cmdAppliquer = New System.Windows.Forms.Button() Me.cmdZoomInit = New System.Windows.Forms.Button() Me.chkEffacerImg = New System.Windows.Forms.CheckBox() Me.pbAvancement = New System.Windows.Forms.ProgressBar() Me.nudNbIterationsMax = New System.Windows.Forms.NumericUpDown() Me.lblIterationMax = New System.Windows.Forms.Label() Me.cmdZoomMoins = New System.Windows.Forms.Button() Me.ToolTip1 = New System.Windows.Forms.ToolTip(Me.components) Me.chkModeDetailIterations = New System.Windows.Forms.CheckBox() Me.txtJuliaY = New System.Windows.Forms.TextBox() Me.txtJuliaX = New System.Windows.Forms.TextBox() Me.pbxJulia = New System.Windows.Forms.PictureBox() Me.lblZoom = New System.Windows.Forms.Label() Me.panelJulia = New System.Windows.Forms.Panel() Me.lblPrmJulia = New System.Windows.Forms.Label() Me.GroupBox1.SuspendLayout() CType(Me.nudDegre, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.nudNbIterationsMax, System.ComponentModel.ISupportInitialize).BeginInit() Me.panelJulia.SuspendLayout() Me.SuspendLayout() ' 'GroupBox1 ' Me.GroupBox1.Controls.AddRange(New System.Windows.Forms.Control() {Me.rbJulia, Me.rbMandelbrot}) Me.GroupBox1.Location = New System.Drawing.Point(8, 8) Me.GroupBox1.Name = "GroupBox1" Me.GroupBox1.Size = New System.Drawing.Size(112, 72) Me.GroupBox1.TabIndex = 0 Me.GroupBox1.TabStop = False Me.GroupBox1.Text = "Ensemble de type" Me.ToolTip1.SetToolTip(Me.GroupBox1, "Types d'ensemble fractal à dessiner") ' 'rbJulia ' Me.rbJulia.Location = New System.Drawing.Point(16, 48) Me.rbJulia.Name = "rbJulia" Me.rbJulia.Size = New System.Drawing.Size(80, 16) Me.rbJulia.TabIndex = 2 Me.rbJulia.Text = "Julia" ' 'rbMandelbrot ' Me.rbMandelbrot.Checked = True Me.rbMandelbrot.Location = New System.Drawing.Point(16, 24) Me.rbMandelbrot.Name = "rbMandelbrot" Me.rbMandelbrot.Size = New System.Drawing.Size(80, 16) Me.rbMandelbrot.TabIndex = 1 Me.rbMandelbrot.TabStop = True Me.rbMandelbrot.Text = "Mandelbrot" ' 'nudDegre ' Me.nudDegre.Location = New System.Drawing.Point(176, 16) Me.nudDegre.Maximum = New Decimal(New Integer() {5, 0, 0, 0}) Me.nudDegre.Minimum = New Decimal(New Integer() {2, 0, 0, 0}) Me.nudDegre.Name = "nudDegre" Me.nudDegre.Size = New System.Drawing.Size(32, 20) Me.nudDegre.TabIndex = 3 Me.nudDegre.Value = New Decimal(New Integer() {2, 0, 0, 0}) ' 'LblDegre ' Me.LblDegre.Location = New System.Drawing.Point(128, 16) Me.LblDegre.Name = "LblDegre" Me.LblDegre.Size = New System.Drawing.Size(48, 16) Me.LblDegre.TabIndex = 5 Me.LblDegre.Text = "Degré :" Me.ToolTip1.SetToolTip(Me.LblDegre, "Degré de l'équation Z -> Z^degré + C") ' 'cmdPause ' Me.cmdPause.Location = New System.Drawing.Point(120, 280) Me.cmdPause.Name = "cmdPause" Me.cmdPause.Size = New System.Drawing.Size(96, 24) Me.cmdPause.TabIndex = 12 Me.cmdPause.Text = "Pause / Reprise" Me.ToolTip1.SetToolTip(Me.cmdPause, "Faire une pause / reprendre le tracé") ' 'cmdStop ' Me.cmdStop.Location = New System.Drawing.Point(120, 312) Me.cmdStop.Name = "cmdStop" Me.cmdStop.Size = New System.Drawing.Size(96, 24) Me.cmdStop.TabIndex = 13 Me.cmdStop.Text = "Stop" Me.ToolTip1.SetToolTip(Me.cmdStop, "Arrêter le tracé") ' 'cmdAppliquer ' Me.cmdAppliquer.Location = New System.Drawing.Point(8, 248) Me.cmdAppliquer.Name = "cmdAppliquer" Me.cmdAppliquer.Size = New System.Drawing.Size(208, 24) Me.cmdAppliquer.TabIndex = 9 Me.cmdAppliquer.Text = "Appliquer" Me.ToolTip1.SetToolTip(Me.cmdAppliquer, "Appliquer ces paramètres et retracer") ' 'cmdZoomInit ' Me.cmdZoomInit.Location = New System.Drawing.Point(8, 312) Me.cmdZoomInit.Name = "cmdZoomInit" Me.cmdZoomInit.Size = New System.Drawing.Size(96, 24) Me.cmdZoomInit.TabIndex = 11 Me.cmdZoomInit.Tag = "" Me.cmdZoomInit.Text = "Zoom Init." Me.ToolTip1.SetToolTip(Me.cmdZoomInit, "Ré-initialiser le zoom") ' 'chkEffacerImg ' Me.chkEffacerImg.Location = New System.Drawing.Point(8, 216) Me.chkEffacerImg.Name = "chkEffacerImg" Me.chkEffacerImg.TabIndex = 7 Me.chkEffacerImg.Text = "Effacer l'image" Me.ToolTip1.SetToolTip(Me.chkEffacerImg, "Effacer l'image à chaque affinage des pixels (en mode remplissage)") ' 'pbAvancement ' Me.pbAvancement.Anchor = ((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.pbAvancement.Location = New System.Drawing.Point(8, 408) Me.pbAvancement.Name = "pbAvancement" Me.pbAvancement.Size = New System.Drawing.Size(216, 16) Me.pbAvancement.TabIndex = 14 ' 'nudNbIterationsMax ' Me.nudNbIterationsMax.Anchor = ((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.nudNbIterationsMax.Location = New System.Drawing.Point(128, 64) Me.nudNbIterationsMax.Maximum = New Decimal(New Integer() {32767, 0, 0, 0}) Me.nudNbIterationsMax.Name = "nudNbIterationsMax" Me.nudNbIterationsMax.Size = New System.Drawing.Size(88, 20) Me.nudNbIterationsMax.TabIndex = 4 Me.nudNbIterationsMax.Value = New Decimal(New Integer() {166, 0, 0, 0}) ' 'lblIterationMax ' Me.lblIterationMax.Location = New System.Drawing.Point(128, 40) Me.lblIterationMax.Name = "lblIterationMax" Me.lblIterationMax.Size = New System.Drawing.Size(80, 16) Me.lblIterationMax.TabIndex = 16 Me.lblIterationMax.Text = "Itération max.:" Me.ToolTip1.SetToolTip(Me.lblIterationMax, "Itération maximum de l'équation Z -> Z^degré + C") ' 'cmdZoomMoins ' Me.cmdZoomMoins.Location = New System.Drawing.Point(8, 280) Me.cmdZoomMoins.Name = "cmdZoomMoins" Me.cmdZoomMoins.Size = New System.Drawing.Size(96, 24) Me.cmdZoomMoins.TabIndex = 10 Me.cmdZoomMoins.Tag = "" Me.cmdZoomMoins.Text = "Zoom -" Me.ToolTip1.SetToolTip(Me.cmdZoomMoins, "Reculer le zoom") ' 'chkModeDetailIterations ' Me.chkModeDetailIterations.Location = New System.Drawing.Point(120, 216) Me.chkModeDetailIterations.Name = "chkModeDetailIterations" Me.chkModeDetailIterations.TabIndex = 8 Me.chkModeDetailIterations.Text = "Détail itérations" Me.ToolTip1.SetToolTip(Me.chkModeDetailIterations, "Afficher le détail des itérations sur un pixel pointé à la souris") ' 'txtJuliaY ' Me.txtJuliaY.Anchor = ((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.txtJuliaY.Location = New System.Drawing.Point(112, 88) Me.txtJuliaY.Name = "txtJuliaY" Me.txtJuliaY.Size = New System.Drawing.Size(96, 20) Me.txtJuliaY.TabIndex = 6 Me.txtJuliaY.Text = "JuliaY" Me.ToolTip1.SetToolTip(Me.txtJuliaY, "Saisissez directement la valeur Y du paramètre de Julia") ' 'txtJuliaX ' Me.txtJuliaX.Anchor = ((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.txtJuliaX.Location = New System.Drawing.Point(112, 56) Me.txtJuliaX.Name = "txtJuliaX" Me.txtJuliaX.Size = New System.Drawing.Size(96, 20) Me.txtJuliaX.TabIndex = 5 Me.txtJuliaX.Text = "JuliaX" Me.ToolTip1.SetToolTip(Me.txtJuliaX, "Saisissez directement la valeur X du paramètre de Julia") ' 'pbxJulia ' Me.pbxJulia.BackColor = System.Drawing.Color.Aqua Me.pbxJulia.Location = New System.Drawing.Point(8, 8) Me.pbxJulia.Name = "pbxJulia" Me.pbxJulia.Size = New System.Drawing.Size(100, 100) Me.pbxJulia.TabIndex = 20 Me.pbxJulia.TabStop = False Me.ToolTip1.SetToolTip(Me.pbxJulia, "Sélectionner le paramètre de Julia en cliquant dans la zone") ' 'lblZoom ' Me.lblZoom.Anchor = ((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.lblZoom.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) Me.lblZoom.Location = New System.Drawing.Point(8, 352) Me.lblZoom.Name = "lblZoom" Me.lblZoom.Size = New System.Drawing.Size(216, 48) Me.lblZoom.TabIndex = 17 Me.lblZoom.Text = "Prm Zoom" ' 'panelJulia ' Me.panelJulia.Anchor = ((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.panelJulia.Controls.AddRange(New System.Windows.Forms.Control() {Me.txtJuliaY, Me.txtJuliaX, Me.lblPrmJulia, Me.pbxJulia}) Me.panelJulia.Enabled = False Me.panelJulia.Location = New System.Drawing.Point(8, 88) Me.panelJulia.Name = "panelJulia" Me.panelJulia.Size = New System.Drawing.Size(216, 120) Me.panelJulia.TabIndex = 5 ' 'lblPrmJulia ' Me.lblPrmJulia.Anchor = ((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right) Me.lblPrmJulia.Location = New System.Drawing.Point(120, 16) Me.lblPrmJulia.Name = "lblPrmJulia" Me.lblPrmJulia.Size = New System.Drawing.Size(88, 32) Me.lblPrmJulia.TabIndex = 21 Me.lblPrmJulia.Text = "Paramètres de Julia : X et Y" ' 'frmConfig ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(232, 429) Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.panelJulia, Me.chkModeDetailIterations, Me.lblZoom, Me.cmdZoomMoins, Me.lblIterationMax, Me.nudNbIterationsMax, Me.pbAvancement, Me.chkEffacerImg, Me.cmdZoomInit, Me.cmdAppliquer, Me.cmdStop, Me.cmdPause, Me.LblDegre, Me.nudDegre, Me.GroupBox1}) Me.Name = "frmConfig" Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual Me.Text = "Configuration de Fractalis" Me.GroupBox1.ResumeLayout(False) CType(Me.nudDegre, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.nudNbIterationsMax, System.ComponentModel.ISupportInitialize).EndInit() Me.panelJulia.ResumeLayout(False) Me.ResumeLayout(False) End Sub #End Region #Region "Propriétés" Public Property iDegre%() Get iDegre = CInt(Me.nudDegre.Value) ' nud : NumericUpDown End Get Set(ByVal iVal%) Me.nudDegre.Value = iVal End Set End Property Public Property iNbIterationsMax() As Short Get iNbIterationsMax = CShort(Me.nudNbIterationsMax.Value) End Get Set(ByVal iVal As Short) Me.nudNbIterationsMax.Value = iVal End Set End Property Public Property ptfJulia() As PointF Get ptfJulia = m_ptfJulia End Get Set(ByVal rVal As PointF) m_ptfJulia = rVal MajTxtJulia(bLimiterPrecision:=False) End Set End Property Public Property bJulia() As Boolean Get bJulia = Me.rbJulia.Checked ' rb : RadioButton End Get Set(ByVal bVal As Boolean) Me.rbJulia.Checked = bVal End Set End Property Public Property bEffacerImg() As Boolean Get bEffacerImg = Me.chkEffacerImg.Checked ' chk : CheckBox End Get Set(ByVal bVal As Boolean) Me.chkEffacerImg.Checked = bVal End Set End Property Public WriteOnly Property iAvancement%() Set(ByVal iVal%) Me.pbAvancement.Value = Math.Min(iVal, 100) ' pb : ProgressBar End Set End Property Public WriteOnly Property sCoordZoom$() Set(ByVal sVal$) Me.lblZoom.Text = sVal ' lbl : Label End Set End Property Public ReadOnly Property bModeDetailIterations() As Boolean Get bModeDetailIterations = Me.chkModeDetailIterations.Checked End Get End Property #End Region #Region "Gestion de l'interface" Private Sub FrmConfig_Closing(ByVal sender As Object, _ ByVal e As System.ComponentModel.CancelEventArgs) _ Handles MyBase.Closing ' Ne pas fermer ce formulaire, le cacher seulement e.Cancel = True : Me.Hide() End Sub Private Sub cmdZoomMoins_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles cmdZoomMoins.Click RaiseEvent EvZoomMoins() End Sub Private Sub cmdZoomInit_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles cmdZoomInit.Click RaiseEvent EvZoomInit() End Sub Private Sub cmdAppliquer_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles cmdAppliquer.Click RaiseEvent EvAppliquer() End Sub Private Sub cmdPause_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles cmdPause.Click RaiseEvent EvPause() End Sub Private Sub cmdStop_Click(ByVal sender As Object, _ ByVal e As EventArgs) Handles cmdStop.Click RaiseEvent EvStop() End Sub Private Sub pbxJulia_Paint(ByVal sender As Object, _ ByVal e As PaintEventArgs) Handles pbxJulia.Paint ' pbx : PictureBox ' Tracer le cercle unitaire Dim iDiamCercleUnitaire% = 2 * Me.pbxJulia.Width \ iAmplitPrmJulia e.Graphics.DrawEllipse(Pens.Red, _ Me.pbxJulia.Width \ 2 - iDiamCercleUnitaire \ 2, _ Me.pbxJulia.Height \ 2 - iDiamCercleUnitaire \ 2, _ iDiamCercleUnitaire, iDiamCercleUnitaire) ' Tracer la cible représentant le paramètre de Julia Const iDiamCercleCible% = 5 e.Graphics.DrawEllipse(Pens.Black, _ Me.pbxJulia.Width \ 2 + CInt(Me.pbxJulia.Width * _ m_ptfJulia.X / iAmplitPrmJulia) - iDiamCercleCible \ 2, _ Me.pbxJulia.Height \ 2 + CInt(Me.pbxJulia.Height * _ -m_ptfJulia.Y / iAmplitPrmJulia - iDiamCercleCible \ 2), _ iDiamCercleCible, iDiamCercleCible) End Sub Private Sub pbPrmJulia_MouseDown(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles pbxJulia.MouseDown m_ptfJulia = New PointF( _ CSng(iAmplitPrmJulia * _ (e.X - Me.pbxJulia.Width / 2) / Me.pbxJulia.Width), _ CSng(iAmplitPrmJulia * _ (-e.Y + Me.pbxJulia.Height / 2) / Me.pbxJulia.Height)) MajTxtJulia(bLimiterPrecision:=True) Me.pbxJulia.Invalidate() End Sub Private Sub MajTxtJulia(ByVal bLimiterPrecision As Boolean) Dim sFormat$ If bLimiterPrecision Then sFormat = "0.00" Me.txtJuliaX.Text = m_ptfJulia.X.ToString(sFormat) ' txt : TextBox Me.txtJuliaY.Text = m_ptfJulia.Y.ToString(sFormat) End Sub Private Sub txtJuliaX_TextChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles txtJuliaX.TextChanged If bConvTxtToSng(Me.txtJuliaX.Text, m_ptfJulia.X) Then _ Me.pbxJulia.Invalidate() End Sub Private Sub txtJuliaY_TextChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles txtJuliaY.TextChanged If bConvTxtToSng(Me.txtJuliaY.Text, m_ptfJulia.Y) Then _ Me.pbxJulia.Invalidate() End Sub Private Function bConvTxtToSng(ByVal sTxt$, ByRef rVal!) As Boolean Try Dim rVal0! = CSng(sTxt) rVal = rVal0 bConvTxtToSng = True Catch End Try End Function Private Sub rbJulia_CheckedChanged(ByVal sender As Object, _ ByVal e As EventArgs) Handles rbJulia.CheckedChanged Me.panelJulia.Enabled = Me.rbJulia.Checked End Sub Private Sub chkDetailIterations_CheckedChanged( _ ByVal sender As Object, ByVal e As EventArgs) _ Handles chkModeDetailIterations.CheckedChanged RaiseEvent EvDetailIterations() End Sub #End Region End Class End Namespace FrmFract.vb ' Fractalis : Traceur de fractales de type Mandelbrot et Julia en VB .NET ' ----------------------------------------------------------------------- ' Créé à partir de Fractalis : ' TRACEUR DE FRACTALES EN VB.NET (7.0) ' http://www.vbfrance.com/article.aspx?ID=6889 ' Basé sur l'explication pour une réalisation en VB6 : ' http://progzone.free.fr/graphisme/mandelvb/mandelvb.html ' Par Patrice Dargenton : patrice.dargenton@free.fr ' http://patrice.dargenton.free.fr/fractal/index.html ' http://patrice.dargenton.free.fr/index.html ' Version 4.0 du 30/1/2003 ' Documentation : Fractalis.html ' Fichier FrmFract.vb ' ------------------- ' Conventions de nommage des variables : ' b pour Boolean (booléen vrai ou faux) ' i pour Integer (%) et Short (System.Int16) ' l pour Long : & ' r pour nombre Réel (Single!, Double# ou Decimal : D) ' a pour Array (tableau) : () ' o pour Object (objet ou classe) ' m_ pour variable Membre de la classe (mais pas pour les constantes) ' Syntaxe plus stricte, surtout pour les conversions de type ' qui doivent être explicites Option Strict On Option Explicit On ' Toute variable doit être déclarée Namespace Fractalis ' Utile si plusieurs projets sont intégrés Public Class frmFractalis Inherits Form #Region "Déclarations" ' Déclaration de la feuille de configuration : ' avec la gestion des événements, il faut utiliser As au lieu de = 'Private m_frmConfig = New frmConfig() Private WithEvents m_frmConfig As New frmConfig() #Const bRemplissage = True ' Tracer avec le mode remplissage #If bRemplissage Then Private WithEvents m_clsFract As New ClsFractRemplissage() #Else Private WithEvents m_clsFract As New ClsFract() #End If ' Ne pas commencer à tracer si la feuille n'est pas initialisée Private m_bInitApp As Boolean ' Application initialisée ? ' Suspendre le tracé quelque temps pendant le redimensionnement ' (resize) de l'application Private m_bSuspendreTracePdtResize As Boolean Private m_bReTracer As Boolean ' Les paramètres ont changés : retracer Private m_gr As Graphics ' Graphique de la feuille Private m_szTailleEcran As New Size() ' Dimension du tracé en pixels ' Mémorisation pour retracer le bitmap au retour d'une iconisation Private m_szMemTailleEcran As New Size() ' Pour gérer le bitmap de cache (buffering) : c'est 15% + rapide Private m_bmpCache As Bitmap Private m_thrdFract As Threading.Thread ' Thread de tracé ' Coordonnées en pixels dans l'ensemble de Mandelbrot ou Julia Private m_rectCoordPixels As New Rectangle() 'Private m_pt1 As New Point() #End Region #Region " Windows Form Designer generated code " Public Sub New() MyBase.New() 'This call is required by the Windows Form Designer. InitializeComponent() 'Add any initialization after the InitializeComponent() call End Sub 'Form overrides dispose to clean up the component list. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub 'Required by the Windows Form Designer Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Friend WithEvents TimerResize As System.Windows.Forms.Timer <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmFractalis)) Me.TimerResize = New System.Windows.Forms.Timer(Me.components) ' 'TimerResize ' Me.TimerResize.Interval = 1000 ' 'frmFractalis ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(392, 392) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Name = "frmFractalis" Me.Text = "Fractalis 4 (bouton droit pour configurer)" End Sub #End Region #Region "Initialisations" Private Sub frmFractalis_Load(ByVal sender As Object, _ ByVal e As EventArgs) Handles MyBase.Load Me.AddOwnedForm(m_frmConfig) ' Gestion de l'iconisation des 2 feuilles m_frmConfig.iDegre = ClsFract.iDegreAlgoDef m_frmConfig.iNbIterationsMax = ClsFract.iNbIterationsMaxDepartDef m_frmConfig.bJulia = (ClsFract.typeFractDef = ClsFract.TFractal.Julia) m_frmConfig.ptfJulia = ClsFract.ptfJuliaDef m_frmConfig.bEffacerImg = ClsFract.bEffacerImgDef m_clsFract.InitialiserPrmFract() m_bReTracer = True End Sub Private Sub frmFractalis_Activated(ByVal sender As Object, _ ByVal e As EventArgs) Handles MyBase.Activated m_bInitApp = True ' On est prêt à tracer maintenant m_bSuspendreTracePdtResize = False End Sub Private Function bIconisation() As Boolean bIconisation = False ' Iconisation, autre poss.: tester WindowState If Me.ClientSize.Width = 0 And Me.ClientSize.Height = 0 Then _ bIconisation = True End Function Private Sub frmFractalis_Resize(ByVal sender As Object, _ ByVal e As EventArgs) Handles MyBase.Resize If bIconisation() Then GoTo Fin StopTrace() InitialiserGraphique() ' Il faut recréer le graphique ' Retour d'une iconisation If m_szTailleEcran.Width = m_szMemTailleEcran.Width And _ m_szTailleEcran.Height = m_szMemTailleEcran.Height Then ' Dans ce cas, on peut réafficher le bitmap pendant le thread ! m_bSuspendreTracePdtResize = False ' Pas besoin du timer invalidate dans ce cas If Not m_bReTracer Then Exit Sub End If m_szMemTailleEcran = m_szTailleEcran ' Si l'application est initialisée, on attend que l'utilisateur ' ait finit de redimensionner la feuille avant de recommencer à tracer If m_bInitApp Then Me.TimerResize.Enabled = True Fin: m_bSuspendreTracePdtResize = True End Sub Private Sub TimerResize_Tick(ByVal sender As Object, _ ByVal e As EventArgs) Handles TimerResize.Tick Me.TimerResize.Enabled = False m_bSuspendreTracePdtResize = False Retracer() End Sub Private Sub InitialiserGraphique() If bIconisation() Then Exit Sub m_szTailleEcran = Me.ClientSize m_clsFract.szTailleEcran = m_szTailleEcran m_gr = Me.CreateGraphics ' Au retour d'une iconisation, garder le bitmap If m_szTailleEcran.Width <> m_szMemTailleEcran.Width Or _ m_szTailleEcran.Height <> m_szMemTailleEcran.Height Then m_bmpCache = New Bitmap( _ m_szTailleEcran.Width, m_szTailleEcran.Height) ' Tracer dans le buffer m_clsFract.Gr = Graphics.FromImage(m_bmpCache) End If m_clsFract.RespecterRatioZoneAbs() MajCoordZoom() End Sub #End Region #Region "Gestion de l'interface" Private Sub frmFractalis_Paint(ByVal sender As Object, _ ByVal e As PaintEventArgs) Handles MyBase.Paint If m_bSuspendreTracePdtResize Then Exit Sub ' Si on a bufferisé et qu'il s'agit d'une simple m.a.j., ' on affiche le bitmap If Not m_clsFract.bQuitterTrace And _ (Not m_bReTracer Or bTraceEnCours()) Then _ MajEcranBmpCache() : Exit Sub StopTrace() m_thrdFract = New Threading.Thread(AddressOf _ m_clsFract.TracerFractProgressif) ' Pas d'amélioration 'm_thrdFract.Priority = Threading.ThreadPriority.Highest m_thrdFract.Start() End Sub Private Sub MajEcranBmpCache() ' Attention : le thread utilise m_gr en même temps : ' on utilise SyncLock m_gr pour éviter les collisions SyncLock m_gr m_gr.DrawImage(m_bmpCache, 0, 0) End SyncLock End Sub Private Sub frmFractalis_Closing(ByVal sender As Object, ByVal e As _ System.ComponentModel.CancelEventArgs) Handles MyBase.Closing StopTrace() End Sub Private Sub frmFractalis_MouseDown(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles MyBase.MouseDown If e.Button = MouseButtons.Left Then StopTrace() If m_clsFract.bModeDetailIterations Then _ m_clsFract.SelectionnerPoint(New Point(e.X, e.Y)) : Exit Sub m_rectCoordPixels = New Rectangle(e.X, e.Y, 0, 0) 'm_pt1 = New Point(e.X, e.Y) End If If e.Button <> MouseButtons.Right Then Exit Sub ' Affichage du panneau de configuration de Fractalis If bTraceEnCours() Then m_thrdFract.Suspend() ' Note : Pour pouvoir fixer la position de la feuille avant d'appeler ' Show(), il faut que m_frmConfig.StartPosition soit sur manual If Me.WindowState = FormWindowState.Normal Then _ m_frmConfig.Location = New Point(Me.Left + Me.Width, Me.Top) m_frmConfig.Show() MajCoordZoom() If bTraceEnCours() Then ' Petit défaut : il faudrait laisser au formulaire le temps ' de s'afficher, mais le Suspend et le Resume ne suffisent pas 'm_thrdFract.Sleep(1000) ' inutile : ne suffit pas ' Attention au problème de synchronisation avec la mise à jour ' du bitmap : cela provoque parfois un blocage ! 'Application.DoEvents() ' Dans la prochaine version, je vais peut être enlever le thread m_thrdFract.Resume() End If End Sub Private Sub frmFractalis_MouseMove(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles MyBase.MouseMove If e.Button <> MouseButtons.Left Then Exit Sub If m_clsFract.bModeDetailIterations Then _ m_clsFract.SelectionnerPoint(New Point(e.X, e.Y)) : Exit Sub MajEcranBmpCache() rectTracerSelection(e) End Sub Private Sub frmFractalis_MouseUp(ByVal sender As Object, _ ByVal e As MouseEventArgs) Handles MyBase.MouseUp If e.Button <> MouseButtons.Left Then Exit Sub If m_clsFract.bModeDetailIterations Then Exit Sub Dim rectNorm As Rectangle = rectTracerSelection(e) If rectNorm.Width = 0 Or rectNorm.Height = 0 Then Exit Sub m_rectCoordPixels = rectNorm m_clsFract.ZoomerZonePixels(m_rectCoordPixels) Retracer() End Sub Private Function rectTracerSelection( _ ByVal e As MouseEventArgs) As Rectangle ' Tracer le cadre de sélection d'une zone à zoomer et ' renvoyer le rectangle normalisé et recadré selon le ' ratio de l'écran, en pixels ' Idée : utiliser le mode XOR pour ne pas effacer le tracé : ' je n'ai pas trouvé comment faire en VB .NET ' Autre solution : retracer le bitmap de cache avant l'appel ' à cette fonction ' Méthode la plus simple s'il n'y a pas besoin de respecter le ratio 'Dim m_pt2 As New Point(e.X, e.Y) 'm_rectCoordPixels = New Rectangle( _ ' Math.Min(m_pt1.X, m_pt2.X), _ ' Math.Min(m_pt1.Y, m_pt2.Y), _ ' Math.Abs(m_pt2.X - m_pt1.X), _ ' Math.Abs(m_pt2.Y - m_pt1.Y)) m_rectCoordPixels.Width = e.X - m_rectCoordPixels.Left m_rectCoordPixels.Height = e.Y - m_rectCoordPixels.Top Dim rectNorm As Rectangle = m_rectCoordPixels rectNorm = rectRespecterRatioZonePixels(rectNorm) rectNorm = rectNormaliserRectangle(rectNorm) SyncLock m_gr m_gr.DrawRectangle(Pens.Black, rectNorm) End SyncLock rectTracerSelection = rectNorm End Function Private Function rectRespecterRatioZonePixels( _ ByVal rectCoordPixels As Rectangle) As Rectangle ' Attention : la zone de sélection doit être proportionnelle ' au ratio de l'écran If m_szTailleEcran.Height >= m_szTailleEcran.Width Then ' \ : Antislash = Division entière If m_szTailleEcran.Width <> 0 Then _ rectCoordPixels.Height = rectCoordPixels.Width * _ m_szTailleEcran.Height \ m_szTailleEcran.Width Else If m_szTailleEcran.Height <> 0 Then _ rectCoordPixels.Width = rectCoordPixels.Height * _ m_szTailleEcran.Width \ m_szTailleEcran.Height End If rectRespecterRatioZonePixels = rectCoordPixels End Function Private Function rectNormaliserRectangle( _ ByVal rect As Rectangle) As Rectangle ' Traiter les rectangles à l'envers rectNormaliserRectangle = rect If rect.Width < 0 And rect.Height < 0 Then rectNormaliserRectangle = New Rectangle( _ rect.Left + rect.Width, rect.Top + rect.Height, _ -rect.Width, -rect.Height) Exit Function End If If rect.Width < 0 Then _ rectNormaliserRectangle = New Rectangle( _ rect.Left + rect.Width, rect.Top, _ -rect.Width, rect.Height) If rect.Height < 0 Then _ rectNormaliserRectangle = New Rectangle( _ rect.Left, rect.Top + rect.Height, _ rect.Width, -rect.Height) End Function Private Sub MajCoordZoom() ' Centre et amplitude du zoom en coordonnées absolues ' 28 décimales : on a besoin du max. de précision 'Const sFormat$ = "0.0000000000000000000000000000" Dim sCoordZoom$ = "Coordonnées du zoom :" sCoordZoom &= vbLf & "X = " & m_clsFract.rCentreX '.ToString(sFormat) sCoordZoom &= vbLf & "Y = " & m_clsFract.rCentreY '.ToString(sFormat) sCoordZoom &= vbLf & "Z = " & m_clsFract.rAmplitX '.ToString(sFormat) m_frmConfig.sCoordZoom = sCoordZoom End Sub Public Sub LireConfig() StopTrace() ' Si les paramètres ont changés, réinitaliser le nombre d'itération Dim bInit As Boolean = False If m_frmConfig.bJulia <> m_clsFract.bJulia Then bInit = True If m_frmConfig.bJulia And _ (m_frmConfig.ptfJulia.X <> m_clsFract.ptfJulia.X Or _ m_frmConfig.ptfJulia.Y <> m_clsFract.ptfJulia.Y) Then bInit = True If m_frmConfig.iDegre <> m_clsFract.iDegre Then bInit = True ' Pour m_clsFract.m_iNbIterationsMin = 0 If bInit Then m_clsFract.InitialiserIterations() m_clsFract.bJulia = m_frmConfig.bJulia If m_frmConfig.bJulia Then m_clsFract.ptfJulia = m_frmConfig.ptfJulia m_clsFract.iDegre = m_frmConfig.iDegre m_clsFract.iNbIterationsMaxDepart = m_frmConfig.iNbIterationsMax m_clsFract.bEffacerImg = m_frmConfig.bEffacerImg m_clsFract.bModeDetailIterations = m_frmConfig.bModeDetailIterations End Sub Public Sub Retracer() m_bReTracer = True ' Provoquer un rafraîchissment de la feuille pour retracer Me.Invalidate() MajCoordZoom() End Sub Public Sub PauseReprendreTrace() ' Faire une pause du thread ou bien reprendre le thread suspendu If Not bTraceEnCours() Then Exit Sub ' Attention : il y a plusieurs énumérations ThreadState ' avec des valeurs différentes !!!??? ' Threading.ThreadState.Running = 2 et ' ThreadState.Running = 0 : ne marche pas ! If m_thrdFract.ThreadState = Threading.ThreadState.Running Then m_thrdFract.Suspend() ElseIf m_thrdFract.ThreadState = Threading.ThreadState.Suspended Then m_thrdFract.Resume() End If End Sub Public Sub StopTrace() If Not bTraceEnCours() Then Exit Sub m_clsFract.bQuitterTrace = True ' On ne peut pas interrompre un thread suspendu If m_thrdFract.ThreadState = Threading.ThreadState.Suspended Then _ m_thrdFract.Resume() m_thrdFract.Abort() m_frmConfig.iAvancement = 0 m_clsFract.bModeDetailIterations = m_frmConfig.bModeDetailIterations End Sub Public Function bTraceEnCours() As Boolean bTraceEnCours = False ' AndAlso : ne pas évaluer si la 1ère condition est fausse If Not m_thrdFract Is Nothing AndAlso m_thrdFract.IsAlive Then _ bTraceEnCours = True End Function #End Region #Region "Gestion des événements particuliers" Private Sub m_frmConfig_EvAppliquer() Handles m_frmConfig.EvAppliquer LireConfig() Retracer() End Sub Private Sub m_frmConfig_EvPause() Handles m_frmConfig.EvPause PauseReprendreTrace() End Sub Private Sub m_frmConfig_EvStop() Handles m_frmConfig.EvStop StopTrace() End Sub Private Sub m_frmConfig_EvZoomInit() Handles m_frmConfig.EvZoomInit StopTrace() m_clsFract.InitialiserPrmFract() LireConfig() Retracer() End Sub Private Sub m_frmConfig_EvZoomMoins() Handles m_frmConfig.EvZoomMoins StopTrace() m_clsFract.InitialiserIterations() m_clsFract.ZoomerMoins() Retracer() End Sub Private Sub m_clsFract_EvMajBmp() Handles m_clsFract.EvMajBmp MajEcranBmpCache() End Sub Private Sub m_frmConfig_EvDetailIterations() _ Handles m_frmConfig.EvDetailIterations m_clsFract.bModeDetailIterations = m_frmConfig.bModeDetailIterations If Not m_clsFract.bModeDetailIterations Then MajEcranBmpCache() End Sub Private Sub m_clsFract_EvDetailIterations(ByVal aPt() As _ Drawing.Point) Handles m_clsFract.EvDetailIterations MajEcranBmpCache() Const iEpaisseurTrait% = 2 Dim penBlanc As New Pen(Color.White, iEpaisseurTrait) Dim i% SyncLock m_gr For i = 1 To aPt.GetUpperBound(0) m_gr.DrawLine(penBlanc, aPt(i - 1), aPt(i)) Next i End SyncLock End Sub Private Sub m_clsFract_EvMajAvancement(ByVal iAvancement%) _ Handles m_clsFract.EvMajAvancement m_frmConfig.iAvancement = iAvancement End Sub Private Sub m_clsFract_EvFinTrace() Handles m_clsFract.EvFinTrace m_bReTracer = False m_frmConfig.iAvancement = 0 m_clsFract.bModeDetailIterations = m_frmConfig.bModeDetailIterations End Sub #End Region End Class End Namespace