Русский_Проект: Арбузы

File Edit View Project Format Debug VB.NET Статьи Задачи Help

Данная страница посвящена материалам с сайта Арбуз - занимательный мир и родственному ему сайту PinkStar Gallery - Программная Живопись

Фигуры Лиссажу - lassage.zip

Аттракторы

На сайте Арбуза выложены новые интересные фигуры

Вот код одного рисунка

Private Sub Command1_Click()   DrawWidth = 2   ScaleMode = 3: ssx = 0.5: ssy = ssx   pi = Atn(1) * 4   a = -50   b = -5   c = -30   xmax = 350   ymax = 350   Line (0, 0)-(xmax * 4, ymax * 4), RGB(227, 231, 230), BF   x1 = 0: y1 = 0: x = 1: y = 1   For v = 0 To 100000 Step 1      x3 = x / Abs(x)      x1 = y - x3 * (Abs(Sin(x) * Cos(b) + c - x * Sin(a + b + c)))      y1 = a - x      col = RGB(v / 12000, v / 700, v / 11800)      If x1 <> 0 Then Line (x * ssx + xmax, y * ssy + ymax)-Step(1, 1), col      x = x1: y = y1   Next vEnd Sub

Для получения разных картинок меняйте коэффициенты a, b,c

Фрактал Курликю

Private Sub Command1_Click()ScaleMode = 3pi = Atn(1) * 4xmax = 500ymax = 10r = 6X1 = 0Y1 = 100t = 3s = 0.0001For v = -10000 To 10000 Step 2    w = s * v ^ t    X2 = X1 + r * Cos(w)    Y2 = Y1 + r * Sin(1 * w)    On Error Resume Next    Col = RGB(0, 0, 0)    Line (X1 + xmax, Y1 + ymax)-(X2 + xmax, Y2 + ymax), Col    X1 = X2 + 0: Y1 = Y2 - 0Next vEnd Sub

Меняйте переменные t, s и шаг цикла для получения разных картинок.

Красные узоры

Новые красивые фрактальные узоры
Вот только один из узоров

Public x As Double, pi As Double, y As Double, t As DoublePrivate Sub Command1_Click()DrawWidth = 3ScaleMode = 3: ssx = 12: ssy = 10pi = Atn(1) * 4xmax = 400ymax = 300x = 0.005: y = 0For v = 0 To 60000 Step 1     t = x     x = y - Sin(x)     y = pi - t  On Error Resume Next    red = Abs(v / 300) Mod 255    green = 0    blue = 0    Col = RGB(red, green, blue)    Line (x * ssx + xmax, y * ssy + ymax)-Step(1, 1), Col    Next vEnd Sub

Паутиноиды

Картинки не привожу, смотрите на сайте Арбуза. Привожу один пример, попробуйте поиграть с параметрами.

Овалы Кассини

Подробнее...

Астроиды

Изменяя значения различных переменных, можете добиться красивых узоров. Приводится только один пример

Пасхальное яйцо

Private Sub Command1_Click()Me.ScaleMode = vbPixelsClsDrawWidth = 2pi = 4 * Atn(1)x0 = 350y0 = 180bb = 160ss = 6n = 0ReDim x1(num), y1(num), a1(num), L1(num)xx1 = 0: yy1 = 0: k = 1: j = 1'*********************************shadow******For a = 180 To 0 Step -6 For x = -a To a Step 0.5  If KeyAscii = 32 Then End   If k = -1 And j = 1 Then j = -j   an = a / 1.2: xn = x / 1.2  tn = (an ^ 2 - xn ^ 2)  If tn > 0 Then    yn = k * tn ^ 0.5 / 4        qrrn = Abs(255 - (-a + 180) / 1)        qggn = Abs(255 - (-a + 180) / 1)        qbbn = Abs(255 - (-a + 180))     col = RGB(qrrn, qggn, qbbn)     xx = xn     yy = 110 + yn     If ss > 1 Then Line (xx + 350 + (a - 180) / 2, yy + 300)-Step(ss, ss), col, BF     If ss = 1 Then PSet (xx + 350, yy + 300), col     Else       zzzz = 0     End If     k = -k: j = -j    Next x    n = n + 1    Next a     '**********************************egg********  For a = 180 To 0 Step -3'For b = 1# To 1.007 Step 0.001 For x = -a To a Step 0.05  If KeyAscii = 32 Then End   If k = -1 And j = 1 Then j = -j   t = (a ^ 2 - x ^ 2)  If t > 0 Then    y = (a - 180) / 2 + k * t ^ 0.5 / (1.6 * 1.0014 ^ x)        qrr = Abs(255 - a / 2.5)        qgg = Abs(255 - a / 1.5)        qbb = Abs(255 - a)     col = RGB(qrr, qgg, qbb)     xx = x     yy = y     If ss > 1 Then Line (xx + 350 + (a - 180) / 2, yy + 300)-Step(ss, ss), col, BF     If ss = 1 Then PSet (xx + 350, yy + 300), col     Else       zzzz = 0     End If    k = -k: j = -j    Next x    n = n + 1    Next aEnd Sub

Ломтик капустный

Розетки

xx = 330yy = 260: X2 = 200: Y2 = 0P = 3.1415926RR = 120RR1 = 10Line (0, 0)-(800, 800), RGB(227, 231, 230), BFFor i = 0 To 360 Step 2For j = 0 To 360 Step 0.8 t = i * P / 180 s = j * P / 180 rr0 = RR1 + 50 * Cos(2# * t) ^ 14 + 50 * (Sin(1 * s + 4 * t)) ^ 24 'rr0 = RR1 + 50 * Sin(0.5 * t) ^ 4 + 30 * (Sin(1 * s + 7 * t)) ^ 44 X = RR * Cos(t) + rr0 * Cos(s) Y = RR * Sin(t) + rr0 * Sin(s) z = 0 'RR * Sin(1 * t) + rr0 * Cos(s) X1 = X / 1 - z * Cos(P / 3) * 0.5 Y1 = Y / 1 - z * Sin(P / 3) * 0.5' red = 0 '190 '255 * rr0 / (RR1 + 70)' green = 0 '215 '255 * Abs(Sin(i / 15))' blue = 0 '190 '255 * Abs(Sin((j) / 20)) red = 255 * rr0 / (RR1 + 70) green = 255 * Abs(Sin(i / 15)) blue = 255 * Abs(Sin((j) / 20)) DrawWidth = 1 If i > 0 And j > 0 Then Line (X1 + xx + 10, Y1 + yy + 40)-(X2 + xx + 10, Y2 + yy + 40), RGB(red, green, blue)X2 = X1Y2 = Y1Next jNext i

Водные опыты юных физиков

Лента Мебиуса

Новые узора с сайта Розовой звезды

скачать программу

Математические розы

Несколько красивых узоров

Лаймовое настроение

А вот и картинка, по-моему, передающая это лаймовое настроение. Еще и удивительная, посмотрите, как цветы вырастают друг из друга. Можно даже рассмотреть одну отдельную веточку

Вот код для VBPublic r, w1, w2, scal, ss, xmax, v, m As Integer Private Sub Command1_Click() Randomize (Timer) ss = 1 xmax = 500 v = 140 w1 = -0.2561797 w2 = -1# x0 = 0 scal = 1950 For x = ss To xmax + 100 Step ss For y = ss To xmax Step ss re = (x - xmax / 2 + 1200) / scal im = (y - xmax / 2 + 1050) / scal For j = 1 To v rere = re re = Exp(re) * Sin(im) + w1 im = Exp(rere) * Cos(im) + w2 k = j If re > 40 Then j = v 'If r > 450 Then j = v Next j ' Debug.Print re, im im = Abs(im) re = Abs(re) red = (42 * k) Mod 255 green = (50 * k) Mod 255 blue = (68 * k) Mod 255 Col = RGB(red, green, blue) If ss > 1 Then Line (x + 0, y - 0)-Step(ss, ss), Col, BF If ss = 1 Then PSet (x, y), Col Next y Next x End Sub Private Sub Command2_Click() End End Sub Private Sub Form_KeyPress(keyascii As Integer) If keyascii = 32 Then End End Sub

Пилюли для Пигмалиона и воздушная кукуруза

Рогатая гусеница

Эффект гусеницы

Узор

Звездная галерея

Целая галерея звезд >>>

Интересный узор

Ломтики

Ломтик черно-белый

Вовсе не потому, что кончились краски, просто получилась удачная картинка:

Закрученное объемное тело выпирает почти как на картинах Сальвадора Дали, а вся композиция напоминает полотна на религиозные темы. Хотя это обычный фрактальчик. Цветной вариант не так красив. Желающие могут доработать (изюминка в множителе при аргументе косинуса). Установите для формы ScaleMode=Pixel
Public r, w1, w2, scal, ss, xmax, v, m As IntegerPrivate Sub Command1_Click()Randomize (Timer)ss = 1xmax = 500v = 540w1 = 1.3 w2 = 0x0 = 0scal = 150For x = ss To xmax + 100 Step ss For y = ss To xmax Step ss re = (x - xmax / 2 + 0) / scal im = (y - xmax / 2 + 0) / scal For j = 1 To v rere = re re = 0.45 * Sin(1 * im) * (Exp(re) + Exp(-re)) + w1 im = -0.5 * Cos(1.27 * im) * (Exp(rere) - Exp(-rere)) + w2 r = Abs(re ^ 2 + im ^ 2) k = j If r > 100000 Then j = v Next j 'Debug.Print re, im im = Abs(im) re = Abs(re) ' red = (0.004 * re) Mod 255 ' green = (0.005 * im) Mod 255 red = (16 * k) Mod 255 green = (16 * k) Mod 255 blue = (16 * k) Mod 255 Col = RGB(red, green, blue) If ss > 1 Then Line (x + 0, y - 0)-Step(ss, ss), Col, BF If ss = 1 Then PSet (x, y), Col Next yNext xEnd Sub

Ломтик логарифмический

Это логарифмический фрактал. Все не очень сложно - реальная часть логарифма комплексного числа равна логарифму модуля этого комплексного числа, а мнимая - углу вектора этого числа с реальной осью. Обратите внимание на "помехи" w1 и w2 и на то, что цвет зависит не от счетчика цикла, как в других фрактальных алгоритмах.

Ломтик синусоидальный

Наконец-то удалось получить фракталы из косинуса комплексного числа. Все не очень сложно: cosz=0.5*(ezi+e-zi), после преобразований получим:

действительная часть = 0.5*cos(y)*(ex+e-x)мнимая часть = 0.5*sin(y)*(ex-e-x)

и текст программы на VB6: