[源码]VB绘制Mandelbrot分形图，效果很酷。不足：边缘不同区域的分界太明显。

Question

WMP的可视化效果,和WinAmp的AVS好象就是用分形图做的!为了这个问题,我还专门发了贴子!

Answer 1

但CSDN里的好色之徒好像不是很多啊

Answer 2

http://topic.csdn.net/u/20080916/11/9d3ee55b-a598-4f9e-9d43-343d6b226156.html?seed=1637578062
算法竞赛：图形模式识别，另外开帖子奖励300分。 

Answer 3

不错-------------------------------------------------
北京国展大型人才招聘会(9.27)
http://www.315job.com/YaoQingHan/20080927.html

Answer 4

不知道有没有vc版本的。-------------------------------------------------
北京国展大型人才招聘会(9.27)
http://www.315job.com/YaoQingHan/20080927.html

Answer 5

昨天看了 维度_数学漫步_5_复数.mkv，很酷对维度，复数，分形想了解的请看这里

Answer 6

学习中，SetDIBits真的是个好东西

Answer 7

有没有精通VC,D3D或者OPENGL的程序员，熟悉虚拟现实行业的优先考虑啊！
有意者请联系，吴先生.
邮箱：[email protected]（我每天都会查收邮件）

Answer 8

lz 去这里看看。这里有几年前的一个例子.这个代码用的是pset方法，速度是比较慢的，但他的算法比较好，支持无限放大。更能体现出Mandelbrot分形图的精髓。期望看到lz的改进版本。
http://www.moon-soft.com/download/soft/1123.htm

Answer 9

我这里也收藏了一个：
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Const PI As Single = 3.14159265358979 / 180
Const bs = 0.7071068 'Sqr(2) / 2  used in darwCDim bq As Boolean
Dim st As Integer
Dim r As Integer
Dim g As Integer
Dim B As Integer
'画C图案
Private Sub drawC(ByVal x As Integer, ByVal y As Integer, ByVal L As Integer, ByVal a As Integer)
Const jd As Integer = 30 'Try to change this value to see some astonish scenes :)
Dim X1 As Integer, Y1 As Integer
  If L >= st Then
    X1 = x + L * Cos(a * PI)
    Y1 = y + L * Sin(a * PI)
    Call drawC(x, y, L * bs, a - jd)
    Call drawC(X1, Y1, L * bs, a + jd)
  Else
    Picture1.Line -(x, y)
  End If
End Sub
'画树叶
Private Sub drawLeaf(ByVal x As Integer, ByVal y As Integer, ByVal L As Integer, ByVal a As Integer)
Const B = 50
Const s2 = 3, s3 = 1.4
Const sL = 2Dim X1 As Integer, Y1 As Integer
Dim X2 As Integer, Y2 As Integer
Dim X22 As Integer, Y22 As Integer
Dim X3 As Integer, Y3 As Integer
Dim X4 As Integer, Y4 As Integer
Dim X44 As Integer, Y44 As IntegerIf L > sL Then
  X3 = x + L * Cos(a * PI)
  Y3 = y + L * Sin(a * PI)
  X4 = X3 + L / s2 * Cos((a + B) * PI)
  Y4 = Y3 + L / s2 * Sin((a + B) * PI)
  X44 = X3 + L / s2 * Cos((a - B) * PI)
  Y44 = Y3 + L / s2 * Sin((a - B) * PI)
  
  X1 = x + L / 3 * Cos(a * PI)
  Y1 = y + L / 3 * Sin(a * PI)
  X2 = X1 + L / s2 * Cos((a - B) * PI)
  Y2 = Y1 + L / s2 * Sin((a - B) * PI)
  X22 = X1 + L / s2 * Cos((a + B) * PI)
  Y22 = Y1 + L / s2 * Sin((a + B) * PI)
  
  Picture1.PSet (x, y)
  Picture1.Line -(X3, Y3)
  Picture1.Line -(X4, Y4)
  Picture1.Line (X1, Y1)-(X2, Y2)
  Picture1.Line (X1, Y1)-(X22, Y22)
  Picture1.Line (X3, Y3)-(X44, Y44)
  Call drawLeaf(X3, Y3, L / s3, a + 2)
  Call drawLeaf(X4, Y4, L / s2, a + B)
  Call drawLeaf(X44, Y44, L / s2, a - B)
  Call drawLeaf(X2, Y2, L / s2, a - B)
  Call drawLeaf(X22, Y22, L / s2, a + B)
End If
  
End Sub
'画灌木丛
Private Sub drawTree(ByVal x As Integer, ByVal y As Integer, ByVal L As Integer, ByVal a As Integer)
Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer
Dim Y1 As Integer, Y2 As Integer, Y3 As Integer, Y4 As Integer
Dim B As Single, jd As Single
Dim ff As Integer, gg As Integer, hh As Integer, h As Integerjd = 60 * PI
B = a * PI
X1 = x + L * Cos(B)
Y1 = y + L * Sin(B)
Picture1.Line (x, y)-(X1, Y1)
X2 = x + (X1 - x) / 3
Y2 = y + (Y1 - y) / 3
X3 = X2 + L * Cos(B + jd) / 4
Y3 = Y2 + L * Sin(B + jd) / 4
X4 = X2 + L * Cos(B - jd) / 4
Y4 = Y2 + L * Sin(B - jd) / 4
Picture1.Line (X2, Y2)-(X3, Y3), , B
Picture1.Line (X2, Y2)-(X4, Y4), , B
Randomize
ff = Int(Rnd * 5): gg = Int(Rnd * 5)
hh = Int(Rnd * 4): h = Int(Rnd * 4) + 3
If L > 2 Then
  If ff <> 0 Then Call drawTree(X1, Y1, L - h, a + Int(Rnd * 20) + Int(Rnd * 20))
  If gg <> 0 Then Call drawTree(X1, Y1, L - h, a - Int(Rnd * 20) - Int(Rnd * 20))
ElseIf hh <> 0 Then Picture1.Circle (X1, Y1), 2
End If
End Sub
'画高大的树
Private Sub drawTree2(ByVal x As Integer, ByVal y As Integer, ByVal L As Integer, ByVal a As Integer, ByVal tt As Integer)
Dim X1 As Integer, Y1 As Integer
Dim i As IntegerFor i = -1 To 1
  X1 = x + L * Cos((a + i * (Int(Rnd * 40) + 20)) * PI)
  Y1 = y + L * Sin((a + i * (Int(Rnd * 40) + 20)) * PI)
  Picture1.Line (x, y)-(X1, Y1)
  If L > 5 Then
    Call drawTree2(X1, Y1, L - 8, a + i * Int(Rnd * 40) + 10, tt)
  Else
    If tt = 1 Then Picture1.Circle (X1, Y1), 2, 180
    If tt = 2 Then Picture1.Line (X1, Y1)-(X1 + Int(Rnd * 5) * i, Y1 + Int(Rnd * 20) + 50), &H1F060
  End If
Next i
End Sub
'画雪花
Private Sub drawSnow(ByVal x As Integer, ByVal y As Integer, ByVal L As Integer, ByVal a As Integer)
Dim LL As Integer, LLL As Integer
Dim X1 As Integer, X2 As Integer, X3 As Integer, X4 As Integer, X5 As Integer
Dim Y1 As Integer, Y2 As Integer, Y3 As Integer, Y4 As Integer, Y5 As IntegerLL = L / 3
LLL = 2 * LL
If LL >= 3 Then
  X1 = x + LL * Cos(a * PI)
  Y1 = y + LL * Sin(a * PI)
  X2 = x + LLL * Cos(a * PI)
  Y2 = y + LLL * Sin(a * PI)
  X3 = x + L * Cos(a * PI)
  Y3 = y + L * Sin(a * PI)
  X4 = X1 + LL * Cos((a - 60) * PI)
  Y4 = Y1 + LL * Sin((a - 60) * PI)
  X5 = X1 + LL * Cos((a + 60) * PI)
  Y5 = Y1 + LL * Sin((a + 60) * PI)
  Picture1.PSet (x, y)  r = (r - 3) Mod 255: g = (g - 2) Mod 255: B = (B - 1) Mod 255
  Picture1.ForeColor = RGB(Abs(r), Abs(g), Abs(B))
  Picture1.Line -(X1, Y1): Picture1.Line -(X4, Y4)
  Picture1.Line -(X2, Y2): Picture1.Line -(X3, Y3)
  Picture1.PSet (X1, Y1): Picture1.Line -(X5, Y5)
  Picture1.Line -(X2, Y2)
  
  Call drawSnow(x, y, LL, a)
  Call drawSnow(X1, Y1, LL, a - 60)
  Call drawSnow(X1, Y1, LL, a + 60)
  Call drawSnow(X2, Y2, LL, a - 120)
  Call drawSnow(X2, Y2, LL, a + 120)
  Call drawSnow(X2, Y2, LL, a)
End If
End Sub
'----------**********----------
Private Sub Form_Load()
Picture1.ScaleHeight = 600
Picture1.ScaleWidth = 800
r = 255: g = 255: B = 255
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
bq = True
End SubPrivate Sub optStyle_Click(Index As Integer)
Frame1.Tag = Index
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Picture1.Refresh
Dim L As Integer 'This is the large scaleSelect Case Frame1.Tag
  Case 0
    Picture1.ForeColor = RGB(200, 100, 50)
    L = 150
    For st = Int(L / bs) - 110 To 2 Step -1
      'Picture1.Cls
      Picture1.PSet (500, 360)
      Call drawC(500, 360, L, 180 - 45)
      'T = Timer
      'Me.Caption = T
      'Do: Loop Until Timer - T > 0.001
    Next st
  
  Case 1
    Picture1.ForeColor = &H10D010
    Call drawLeaf(x, y, 120, 270)
  
  Case 2
    Picture1.ForeColor = RGB(220, 120, 60)
    For j = 1 To 6
      Call drawTree(Int(Rnd * 400) + 100, Int(Rnd * 150) + 300, Int(Rnd * 30) + 15, Int(Rnd * 50) + 270)
    Next j
    
  Case 3
    Picture1.ForeColor = &H18000
    Picture1.Line (x, y)-(x, y + 120)
    Call drawTree2(x, y, 50, -90, 2)
    Picture1.Line (x - 50, y - 50)-(x - 50, y - 50 + 120)
    Call drawTree2(x - 50, y - 50, 50, -90, 1)  Case 4
    Static i As Integer
    cx = x: cy = y: L = 360
    Call drawSnow(cx, cy, L, 300 + i)
    Call drawSnow(cx, cy, L, 240 + i)
    Call drawSnow(cx + L * Cos((240 + i) * PI), cy + L * Sin((240 + i) * PI), L, 360 + i)
    i = i + 15
End Select
End SubPrivate Sub Command1_Click()
Dim tc As Integer, ss As Integer
Dim x As Long, y As Long
Dim cx As Integer, cy As Integer
Dim i As Integer, j As Integer
Dim a As Integer, c As Integertc = 256
  For x = 0 To 800
    Picture1.Line (x, 0)-(800 - x, 600), x Mod tc - 1
  Next x
  For y = 0 To 600
    Picture1.Line (0, y)-(800, 600 - y), y Mod tc - 1
  Next y
'cx = 400: cy = 300: ss = cy
cx = 400 / 800 * Picture1.Width / Screen.TwipsPerPixelX
cy = 300 / 600 * Picture1.Height / Screen.TwipsPerPixelY
ss = cy
For a = 1 To 30
  x = a
  For i = 0 To ss
    y = x
    For j = i To cx
      DoEvents
      If bq = True Then Exit Sub
      c = ((x * x + y * y) \ 1024) Mod tc - 1
      'Picture1.PSet (cx + i, cy + j), c
      'Picture1.PSet (cx + j, cy + i), c
      'Picture1.PSet (cx + j, cy - i), c
      'Picture1.PSet (cx + i, cy - j), c
      'Picture1.PSet (cx - i, cy - j), c
      'Picture1.PSet (cx - j, cy - i), c
      'Picture1.PSet (cx - j, cy + i), c
      'Picture1.PSet (cx - i, cy + j), c
      SetPixel Picture1.hdc, cx + i, cy + j, c
      SetPixel Picture1.hdc, cx + j, cy + i, c
      SetPixel Picture1.hdc, cx + j, cy - i, c
      SetPixel Picture1.hdc, cx + i, cy - j, c
      SetPixel Picture1.hdc, cx - i, cy - j, c
      SetPixel Picture1.hdc, cx - j, cy - i, c
      SetPixel Picture1.hdc, cx - j, cy + i, c
      SetPixel Picture1.hdc, cx - i, cy + j, c
      
      y = y + a
    Next j
    x = x + a
  Next i
Next a
End Sub