VERSION 5.00 Begin VB.Form Form1 Caption = "Mandelbrot explorer - http://boltthrower.webhop.org" ClientHeight = 975 ClientLeft = 4395 ClientTop = 2190 ClientWidth = 1320 LinkTopic = "Form1" ScaleHeight = 975 ScaleWidth = 1320 Begin VB.CheckBox Check3nls Caption = "Check3nls" Height = 315 Left = 240 TabIndex = 2 Top = 600 Visible = 0 'False Width = 135 End Begin VB.CheckBox Check2sj Caption = "Check2sj" Height = 195 Left = 240 TabIndex = 1 Top = 480 Visible = 0 'False Width = 135 End Begin VB.CheckBox Check1dc Caption = "Check1dc" Height = 195 Left = 240 TabIndex = 0 Top = 240 Visible = 0 'False Width = 135 End Begin VB.Image Image1 Height = 15 Left = -20 Top = -20 Width = 15 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim xa_mouse Dim ya_mouse Dim xb_mouse Dim yb_mouse Dim xmax As Double Dim xmin As Double Dim ymax As Double Dim ymin As Double Dim old_w As Long Dim old_h As Long Dim ningr 'Option Explicit 'Dim img1 As Image Dim zmin Dim zmax Dim zdistr(0 To 300) As Long Dim zdistrc(0 To 300) As Long Dim zdistrl As Integer Dim maxsteps Private m_cDib As New cDIBSection Sub zn1(ByRef X As Double, ByRef Y As Double, cx As Double, cy As Double) ' calcola la successione Dim a As Double Dim b As Double a = X * X - Y * Y + cx b = (2 * (Sin(X * Y))) * X * Y + cy 'If X <> 0 Then ' b = 2 * X * Y + cy / X 'Else ' b = 2 * X * Y 'End If 'b = 2 * X * Y + cy X = a Y = b End Sub Function fnx(X As Double, Y As Double) 'fnx = Sin((x + 1) * (y - 1)) + (Cos(x * y) + 1.001) 'fnx = Sin((x + 1) * (y - 1)) / (Cos(x * y) + 1.001) 'fnx = Sin(Sin(x * y)) Dim tx As Double Dim ty As Double tx = X ty = Y 'For i = 1 To 10 i = 1 While i < maxsteps And Sqr(tx * tx + ty * ty) < 2 Call zn1(tx, ty, X, Y) i = i + 1 Wend 'fnx = Sqr(tx * tx + ty * ty) fnx = i End Function Sub rgb2hsv(r, g, b, ByRef H, ByRef s, ByRef v) 'ho invertito l'ordine dei parametri rispetto alla funzione C originale max_rgb = r If g > max_rgb Then max_rgb = g If b > max_rgb Then max_rgb = b min_rgb = r If g < min_rgb Then min_rgb = g If b < min_rgb Then min_rgb = b v = max_rgb If max_rgb <> 0 Then s = (max_rgb - min_rgb) / max_rgb Else s = 0 If s = 0 Then H = 0 Else rc = (max_rgb - r) / (max_rgb - min_rgb) gc = (max_rgb - g) / (max_rgb - min_rgb) bc = (max_rgb - b) / (max_rgb - min_rgb) End If If (r = max_rgb) Then H = bc - gc Else If g = max_rgb Then H = 2 + rc - bc Else If (b = max_rgb) Then H = 4 + gc - rc End If End If H = H * 60 If (H < 0) Then H = H + 360 End If H = H / 360 ' scale to range 0..1 End If End Sub 'ok, sto usando questa Sub hsv2rgb(H As Double, s As Double, v As Double, ByRef r, ByRef g, ByRef b) ht = H * 360 ' convert from 0..1 to 0..360 If v = 0 Then r = 0 g = 0 b = 0 Else If s = 0 Then r = v g = v b = v Else If ht = 360 Then ht = 0 End If ht = ht / 60 i = Int(ht) f = ht - i p = v * (1# - s) q = v * (1# - s * f) t = v * (1# - s * (1# - f)) If i = 0 Then r = v g = t b = p ElseIf i = 1 Then r = q g = v b = p ElseIf i = 2 Then r = p g = v b = t ElseIf i = 3 Then r = p g = q b = v ElseIf i = 4 Then r = t g = p b = v ElseIf i = 5 Then r = v g = p b = q End If End If End If 'Print #1, "funz", H * 256, S * 256, V * 256, r * 256, g * 256, b * 256 End Sub Sub campiona(ByRef zmin, ByRef zmax) Dim X As Double Dim Y As Double zmin = 1E+41 zmax = -1E+41 For v = 1 To 10000 i = Rnd(1) j = Rnd(1) X = i * (xmax - xmin) + xmin Y = j * (ymax - ymin) + ymin i = i * old_w j = j * old_h f = fnx(X, Y) If f < zmin Then zmin = f End If If f > zmax Then zmax = f End If Next End Sub Sub visualizza(xmin As Double, xmax As Double, ymin As Double, ymax As Double) old_w = Form1.ScaleWidth old_h = Form1.ScaleHeight Dim X As Double Dim Y As Double 'Call campiona(zmin, zmax) zmin = 0 zmax = maxsteps 'forzo a maxsteps * uso specifico con mandelbrot 'Open "c:\temp\test-vb.txt" For Append As #1 'Print #1, zmin, zmax 'Print #1, "sw=" + Str(Form1.ScaleWidth) For i = 0 To zdistrl zdistr(i) = 0 Next i For i = 0 To old_w Step 1 For j = 0 To old_h Step 1 X = (i / old_w) * (xmax - xmin) + xmin Y = (j / old_h) * (ymax - ymin) + ymin f = (fnx(X, Y) - zmin) / zmax ar_pos = f * zdistrl zdistr(ar_pos) = zdistr(f * zdistrl) + 1 f = f * 256 * 256 * 256 'zdistrc(ar_pos) = f 'f_red = f And &HFF 'f_blue = (f And &HFF0000) '/ 256 / 256 'non funziona.. 'f_blue = (f And &HFF0000) / 256 / 256 'f_green = ((f And &HFF00) / 256) And &HFF H = (f And &HFF0000) / 256 / 256 s = ((f And &HFF00) / 256) And &HFF v = f And &HFF Call hsv2rgb(H / 256, s / 256, v / 256, r1, g1, b1) '--uncomment to not convert ' r1 = H / 256 ' g1 = s / 256 ' b1 = v / 256 'Form1.Line (i, j)-(i + 1, j + 1), f 'Form1.Line (i, j)-(i + 1, j + 1), RGB(i * 2, (i + j), j * 2) Form1.Line (i, j)-(i + 1, j + 1), RGB(r1 * 256, g1 * 256, b1 * 256) zdistrc(ar_pos) = r1 * 256 * 256 * 256 + g1 * 256 * 256 + b1 * 256 'Print #1, f_red, f_green, f_blue 'Print #1, f_red, f_green, f_blue, r1 * 256, g1 * 256, b1 * 256 Rem Xtab(i, j) = f Next DoEvents Next Call scrivi_html(xmin, xmin) End Sub Private Sub Form_DblClick() Form2.Show modal End Sub Private Sub Form_Initialize() maxsteps = 200 zdistrl = 200 ningr = 0 AutoRedraw = True If xdivisore = 0 Then xdivisore = 1000 End If 'xdivisore = xdivisore * 100 Form1.ScaleMode = 3 '= pixel 'RANGE da ANALIZZARE If xmin = 0 Then xmin = -2 xmax = -xmin ymin = xmin ymax = -xmin End If Call visualizza(xmin, xmax, ymin, ymax) 'm_cDib.CreateFromPicture (Me.hdc) 'Dim hDib As Long 'Call m_cDib.CreateFromPicture(Form1.Picture) 'img1.Picture = Form1.Picture '--così funziona! 'Image1.Picture = Form1.Image 'm_cDib.CreateFromPicture Image1.Picture 'così non funziona!!! 'm_cDib.CreateFromPicture Form1.Image 'così non funziona!!! 'img1.Picture = Form1.Image 'm_cDib.CreateFromPicture img1.Picture 'Open "c:\temp\test-vb.txt" For Append As #1 'Print #1, "m_cDIB", m_cDib.Height 'Print #1, "m_cDIB", m_cDib.Width 'Print #1, "m_cDIB", m_cDib.BytesPerScanLine 'Print #1, "m_cDIB", m_cDib.hDib 'Close #1 'm_cDib.CopyToClipboard (False) 'Call m_cDib.CreateDIB(Me.hdc, Me.Width, Me.Height, hDib) End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) xa_mouse = X ya_mouse = Y End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) xb_mouse = X yb_mouse = Y If xb_mouse > xa_mouse And yb_mouse > ya_mouse Then If Form1.Check3nls.Value <> 1 Then 'If Not cb3 Then Form1.Line (xa_mouse, ya_mouse)-(xa_mouse, yb_mouse), RGB(255, 0, 0) Form1.Line (xa_mouse, yb_mouse)-(xb_mouse, yb_mouse), RGB(255, 0, 0) Form1.Line (xb_mouse, yb_mouse)-(xb_mouse, ya_mouse), RGB(255, 0, 0) Form1.Line (xb_mouse, ya_mouse)-(xa_mouse, ya_mouse), RGB(255, 0, 0) End If '------- newxmin = (xa_mouse / old_w) * (xmax - xmin) + xmin newYmin = (ya_mouse / old_h) * (ymax - ymin) + ymin newXmax = (xb_mouse / old_w) * (xmax - xmin) + xmin newYmax = (yb_mouse / old_h) * (ymax - ymin) + ymin '---- Call scrivi_html(xmin, newxmin) '--------- xmin = newxmin ymin = newYmin xmax = newXmax ymax = newYmax Call visualizza(xmin, xmax, ymin, ymax) End If End Sub Sub scrivi_html(xmin, newxmin) Image1.Picture = Form1.Image m_cDib.CreateFromPicture Image1.Picture, old_w, old_h 'm_cDib.CreateFromPicture Form1.Image, old_w, old_h '[ ??? 'gli ultimi 2 parametri sono passati al contrario perchè anche nella classe sono invertiti '(non so però a che livello di utilizzo) '?? forse mi sono sbagliato..] 'm_cDib.Height = Form1.Height 'm_cDib.Width = Form1.Width ' non si poteva impostare in questo modo la proprietà Image1.Height = 0 Image1.Width = 0 Call SaveJPG(m_cDib, "c:\temp\mandel" & ningr & ".jpg", 100) m_cDib.ClearUp '------------ If newxmin <> xmin Then ningr = ningr + 1 End If If Form1.Check2sj.Value <> 1 Then Open "c:\temp\mandel" & ningr & ".html" For Output As #2 Print #2, "<html><head><meta http-equiv='Content-Type' content='text/html; charset=iso-8859-1'>" Print #2, "</head><body><img src='mandel" & ningr & ".jpg'>" Print #2, "<br><br>x in[" & xmin & "," & xmax & "] " Print #2, "<br>y in[" & ymin & "," & ymax & "] " Print #2, "<br>z sampled in[" & zmin & "," & zmax & "] <br><br>" If Form1.Check1dc.Value = 1 Then Print #2, "<table border cellpadding =4 ><tr><th>class</th><th>quant.</th><th>color</th></tr>" For i = 0 To zdistrl Print #2, "<tr><td>" & i & "</td><td>" & zdistr(i) & "</td><td bgcolor= #" & Hex(zdistrc(i)); "></td></tr>" Next i Print #2, "</table><br><br>" End If If newxmin <> xmin Then Print #2, "<a href='mandel" & (ningr) & ".html'> successivo</a>" End If Print #2, "</body></html>" Close #2 End If End Sub Private Sub Form_Unload(Cancel As Integer) Unload Form2 End Sub