forum.boolean.name

forum.boolean.name (http://forum.boolean.name/index.php)
-   PureBasic (http://forum.boolean.name/forumdisplay.php?f=90)
-   -   Fractals (http://forum.boolean.name/showthread.php?t=2513)

Chrono Syndrome 25.01.2007 21:17
Fractals
 
Последнее время я что-то увлеклась фрактальной графикой... Больно уж мне импонирует сама идея создания сложных узоров всего из одной формулы. Так вот, для тех, кто также желает познакомиться с фракталами, публикую небольшой шаблончик:
Код:
InitSprite()
OpenWindow(0, 0, 0, 800, 600, "--Fractal Test--", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Define Width = WindowWidth(0) - 1, Height = WindowHeight(0) - 1, X, Y
OpenWindowedScreen(WindowID(0), 0, 0, Width + 1, Height + 1, #False, 0, 0)
StartDrawing(ScreenOutput())
For X = 0 To Width
For Y = 0 To Height
;--Fractal[--;
; Insert your fractal formula here !
;--]Fractal--;
Next Y
Next X
StopDrawing()
While WaitWindowEvent() <> #PB_Event_CloseWindow
Wend
Некоторые хорошие замены строке "; Insert your fractal formula here" :
Код:
;=-----------------------------------------------------=
Plot(X, Y, Pow((X * 3), Sin(Y) * Cos(X)) / Y+X * Y+X)
;=-----------------------------------------------------=
V.C = (X ! ~Y) * ~11000 - Y*~X
Plot(X, Y, RGB(V, V, V))
;=-----------------------------------------------------=
Plot(X, Y, Pow(Cos(X) / Sin(Y), Sqr(X*Y)+10000000))
;(Впечатляет не очень, но эффект интересный)
;=-----------------------------------------------------=
Да, если найдете еще какие интересные формулы - пишите, составим коллекцию !

impersonalis 26.01.2007 00:54
Re: Fractals
 
смотрим http://boolean.name/showthread.php?t=17
там находим http://algolist.manual.ru/graphics/index.php

jimon 26.01.2007 08:52
Re: Fractals
 
идем суда
http://www.apophysis.org/
берем много (!) пива и изучаем етот гениальный метод генерации
после етого мы получаем мега редактор :)

потом идем суда
http://spanky.triumf.ca/
ну и изучаем там все :)

да и еще - пользуемся вики
http://en.wikipedia.org/wiki/Newton_fractal ... ну там еще куча статей по ним

kvitaliy 26.01.2007 10:50
Re: Fractals
 
Данный код рисует изображение множества Мандельброта. В общем ни чего особенного, но интересно поиграться - если кликнуть мышкой в левый верхний угол предполагаемого прямоугольника, а
потом в правый нижний угол этого же прямоугольника, то он выделиться и нажать на кнопку "Построить", то будет построена увеличенная копия этого места. Так можно повторить несколько раз, получая каждый раз новые интересные узоры.
А ещё текущая картинка сохраняется в BMP
Код:
;{ К сожалению не могу указать настоящего автора, но что то было по немецки и для V3.92
; Я только не много подкорректировал и привёл к V4.0
;
;}
 

InitSprite()
Global m, n, zaehler
Global aktx1,akty1,aktx2,akty2
Define.f
Global seite, spalt, t
Global ecke_im, ecke_re, c_im, c_re, z_im, z_re
Define.l

hwnd=OpenWindow(1,0,0,800,500,"Mandelbrot",#PB_Window_SystemMenu|#PB_Window_WindowCentered)
OpenWindowedScreen(WindowID(1),0,0,500,500,0,0,0)
CreateGadgetList(WindowID(1))
TextGadget(20,510,10,130,20,"Разрешение (пиксел):")
StringGadget(1,650,10,140,20,"500",#PB_String_Numeric)
ButtonGadget(2,510,40,60,20,"Построить")
ButtonGadget(6,650,40,140,20,"Новое разрешение")

TextGadget(21,510,70,90,20,"Размер :")
StringGadget(3,650,70,140,20,"2.5")
TextGadget(22,510,100,130,20,"Действительная ось:")
StringGadget(4,650,100,140,20,"-2.0")
TextGadget(23,510,130,130,20,"Мнимая ось:")
StringGadget(5,650,130,140,20,"-1.25")
TextGadget(24,650,230,130,20," ")
Repeat

anzFelder=Val(GetGadgetText(1))
aktseite.f=ValF(GetGadgetText(3))
aktre.f=ValF(GetGadgetText(4))
aktim.f=ValF(GetGadgetText(5))
UpdateWindow_(WindowID(1))
Repeat
  ClearScreen(RGB(0,0,0))
  event=WindowEvent()
 
  If event = 0
    Delay(10)
  EndIf
 
  If event=#PB_Event_Gadget
    Select EventGadget()
      Case 2
        anzFelder=Val(GetGadgetText(1))
        seite=ValF(GetGadgetText(3))
        spalt=seite/anzFelder
       
        ecke_re=ValF(GetGadgetText(4))
        ecke_im=ValF(GetGadgetText(5))
        Break
      Case 6
        anzFelder=Val(GetGadgetText(1))
        seite=aktseite
        spalt=seite/anzFelder
       
        ecke_re=aktre
        ecke_im=aktim
        Break
    EndSelect
  EndIf
  If image
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(1),0,0,500,500)
    StopDrawing()
  EndIf
 
  winx=WindowMouseX(1)
  winy=WindowMouseY(1)
  If gedr=0 And GetAsyncKeyState_(#VK_LBUTTON)
    If winx<500 And winx>0 And winy<500 And winy>0
      aktx1=WindowMouseX(1)
      akty1=WindowMouseY(1)
      gedr=1
      aktx2=0
      akty2=0
      Repeat
      Until GetAsyncKeyState_(#VK_LBUTTON)=0
    EndIf
  ElseIf gedr=1 And GetAsyncKeyState_(#VK_LBUTTON)
    If winx<500 And winx>0 And winy<500 And winy>0
      aktx2=WindowMouseX(1)
      akty2=WindowMouseY(1)
      gedr=0
      seit.f=aktseite/(500/Abs(aktx2-aktx1))
      re.f=aktre+(aktseite/(500/aktx1))
      im.f=aktim+(aktseite/(500/akty1))
      SetGadgetText(4,StrF(re)) ;re
      SetGadgetText(5,StrF(im)) ;im
      SetGadgetText(3,StrF(seit)) ;seite
      Repeat
      Until GetAsyncKeyState_(#VK_LBUTTON)=0
    EndIf
  EndIf
  StartDrawing(ScreenOutput())
    If aktx1 And akty1 And aktx2 And akty2
      DrawingMode(4)
      Box(aktx1,akty1,aktx2-aktx1,akty2-akty1,$FF0000)
    EndIf
  StopDrawing()
 
  FlipBuffers()
Until event=#PB_Event_CloseWindow
If event=#PB_Event_CloseWindow
  End
EndIf


CreateImage(1,anzFelder,anzFelder)

StartDrawing(ImageOutput(1))

;Расчет
For n= 1 To anzFelder
  For m= 1 To anzFelder
    c_re=ecke_re+n*spalt
    c_im=ecke_im+m*spalt
   
    z_re=0
    z_im=0
   
    zaehler=0
    Repeat
      t=2*z_re*z_im+c_im
      z_re=z_re*z_re-z_im*z_im+c_re
      z_im=t
     
      zaehler=zaehler+1
    Until zaehler>1000 Or (z_im*z_im+z_re*z_re)>4
   
    ;Рисуем в цвете
    If zaehler>1000
      Plot(n,m,0)
    Else
      Plot(n,m,zaehler*1677)
    EndIf
   
  Next
  SetGadgetText(24, "Идёт построение ...")
Next
StopDrawing()
SetGadgetText(24, " ")
SaveImage(1,"Mandelbrot.bmp",#PB_ImagePlugin_BMP)
image=1
ForEver

Chrono Syndrome 26.01.2007 11:56
Re: Fractals
 
Эх, а я тут еще одну забавную формулу для своей проги нашла :
Код:
V.C = Pow(X+y, 2)
Plot(X, Y, V)

ZanoZa 26.01.2007 19:21
Re: Fractals
 
Код:
V.C = Pow(X+y*10, 2)
Plot(X, Y, V)
Код:
V.C = Pow(X+y*12, 2)
Plot(X, Y, V)
Код:
V.C = Pow(Sqr(x+y), 2)
Plot(X, Y, V)
Код:
V.C = Pow((x-400)*(x-400)+(y-300)*(y-300), 2)
Plot(X, Y, V)
видоизменил код.
последний эффект ваще отжоговый :)

ZanoZa 26.01.2007 19:32
Re: Fractals
 
Вложений: 2
крест
Код:
V.C = Pow((x-400)*(x-400)+(y-300)*(y-300), 2)
Plot(X, Y, V)
похоже на двойную гиперболу(ветви - вверх, вниз, влево, вправо) закращенная внутрях :)
Код:
V.C = Pow((x-400)*(x-400)-(y-300)*(y-300), 2)
Plot(X, Y, V)
:)
Код:
V.C = Pow(Sqr((x-400)*(x-400)+(y-300)*(y-300)), 2)
Plot(X, Y, V)
Код:
V.C = Pow(Sqr((x-400)*(x-400)-(y-300)*(y-300)), 2)
Plot(X, Y, V)
ищо
Код:
V.C = Pow(Sqr((x-400)*(x-400)*(y-300)*(y-300)), 2)
Plot(X, Y, V)
ого скока комбо можно вывести ещё!
p.s.в аттаче ещё :)

Chrono Syndrome 26.01.2007 20:10
Re: Fractals
 
Симпатичный узорчик :
Код:
V = Tan(Sin(X)+Cos(Y))*30
Plot(X, Y, V)

ZanoZa 26.01.2007 20:14
Re: Fractals
 
Код:
V =Tan(Sin(X*y)+Cos(Y*x))*70
а как такой? :)

Chrono Syndrome 26.01.2007 20:29
Re: Fractals
 
Цитата:
Сообщение от ZanoZa
Код:
V =Tan(Sin(X*y)+Cos(Y*x))*70
а как такой? :)
Прикольно . А вот еще лучше:
Код:

V = ~X*~Y
V = Tan(V)*8
Plot(X, Y, V)

ZanoZa 26.01.2007 20:40
Re: Fractals
 
ооо ваще круть!
тока я не догоняю зачем ~X ~Y?

Код:
V = (x*(x+100)+y*(y+100))
;)
дождь
Код:
V = (x*(x+400)+y*(y+300))*Sin(x+y)

Chrono Syndrome 26.01.2007 20:43
Re: Fractals
 
Цитата:
тока я не догоняю зачем ~X ~Y?
Символ '~' - это Bitwise NOT в пурике.

ZanoZa 26.01.2007 21:04
Re: Fractals
 
то есть не X и не Y? есди да, то что это даёт?

Chrono Syndrome 26.01.2007 21:32
Re: Fractals
 
Цитата:
то есть не X и не Y?
Нет.

Цитата:
есди да, то что это даёт?
Это дает значения X и Y с инвертированными битами.

ZanoZa 26.01.2007 22:15
Re: Fractals
 
понятно

HolyDel 27.01.2007 02:21
Re: Fractals
 

как уже написала Chrono, ~ - инвертирует биты. ето есть и в блитз и в С++. для чисел со знаком как правило число меняется на противоположное по модулю число и еще -1. например ~6=-7 ;~-7 = 6;~0 = -1; и т.д.
например
для данного случая ~a*~b равносильно (a+1)*(b+1). Хотя второе будет выполняться медленнее.
ПС. За всю мою девелоперскую жизнь ета операция ни разу ни пригодилась.


/Chrono Syndrome: Еще раз напишешь "Chrone", убью ...

ZanoZa 27.01.2007 10:20
Re: Fractals
 

я сначала не понял про что вы говорил, потом после внимательного прочтения понял что это про биты :)

jimon 27.01.2007 11:16
Re: Fractals
 
я тут смотрю на ваши фракталы
ето простые неинтернируемые формулы для построения графиков ...
посмотрите на вот ето http://www.gamedev.ru/code/forum?id=50111
тут 4д график строится :) и все намного увлекательней :)

фрактал геометрический ето вообще интернируемая функция
http://www.codenet.ru/progr/fract/fractr1.php
поетому вы балуетесь графиками ... :)

ps. может я и не прав ... но ето imho правильно

Chrono Syndrome 27.01.2007 12:17
Re: Fractals
 
Цитата:
посмотрите на вот ето http://www.gamedev.ru/code/forum?id=50111
тут 4д график строится :) и все намного увлекательней :)
Красиво... Надо будет как-нибудь попробовать соорудить что-то подобное...

Chrono Syndrome 27.01.2007 14:21
Re: Fractals
 
Код:
для данного случая ~a*~b равносильно (a+1)*(b+1). Хотя второе будет выполняться медленнее.
Да я там, честно говоря, эти операции уже попросту от балды лепила :@ ...

Нашла сегодня еще один красивый график:
Код:
V = (Y - 300) * (X - 400) * 7
Plot(X, Y, V)

ZanoZa 27.01.2007 19:16
Re: Fractals
 
Джимон за сссылки канешна спс, но чё-то помимо слов я от тебя ниче не заметил ;)

ResX 10.11.2007 06:41
Re: Fractals
 
Вложений: 2
Код:
InitSprite() : InitKeyboard()
OpenWindow(0, 0, 0, 400, 400, "--Fractal Test--", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
MessageRequester("Кнопги", "I - показать FPS, счётчик и формулу" + #CRLF$ + "F - перейти к отображению в полном экране (800x600)" + #CRLF$ + "W - перейти к отображению в окне" + #CRLF$ + "Esc - убить прожку")
Global Width = WindowWidth(0) - 1, Height = WindowHeight(0) - 1, X, Y, link.l = 10, full_screen.b = 0, xxx.l = 0, str.s = "", f.l = 0, t.l = GetTickCount_()
OpenWindowedScreen(WindowID(0), 0, 0, Width + 1, Height + 1, #False, 0, 0)
SetActiveWindow(0)
LoadFont(0, "Comic Sans MS", 10, #PB_Font_Bold)
LoadFont(1, "Tahoma", 7)
CreateImage(0,200,200)
CreateSprite(0, 400, 400)
Procedure d(d.l)
If IsScreenActive()
str = "fps: " + StrD(f / ((GetTickCount_() - t)  / 1000), 1) + " * link = " + StrQ(link)
If GetTickCount_() - t = 10000
 t = GetTickCount_()
 f = 0
EndIf
ResizeImage(0, 200, 200)
StartDrawing(ImageOutput(0))
 Box(0, 0, 200, 200)
 GetCursorPos_(cmxy.POINT)
 For X = 20 To 180
  For Y = 20 To 180
;--Fractal[--;
  ;delta = Tan(x) * Tan(y) * ATan((x * y) * #PI)
  one_of = Sin(Sqr( ((x + Log10(y / #PI / 100000000)) * link) + ((y + Log10(x / #PI / 100000000)) * (link / #PI)) )) * link
  xxx = one_of * (ATan(link + (link / #PI)) + #PI)
  Plot(x, y, xxx)
;--]Fractal--;
  Next Y
 Next X
StopDrawing()
FlipBuffers(2) : ClearScreen(Sqr(Sin(link / #PI) * #PI * Log(link / 360)))
 ResizeImage(0, 400, 400)
If IsScreenActive()
StartDrawing(SpriteOutput(0))
 DrawingMode(#PB_2DDrawing_Transparent)
 DrawImage(ImageID(0), 0, 0)
 If GetAsyncKeyState_(#VK_I)
  DrawingFont(FontID(0))
  DrawText(10, 10, str, #White)
  DrawingFont(FontID(1))
  DrawText(10, 365, "Sin(Sqr( ((x + Log10(y / #PI / 100000000)) * link) + ((y + Log10(x / #PI / 100000000))", #White)
  DrawText(10, 375, " * (link / #PI)) )) + ((y + Log10(x / #PI / 100000000)) * (link / #PI)) )) * link", #White)
  DrawText(10, 385, " * (ATan(link + (link / #PI)) + #PI) - формула, которая рисует всё это...", #White)
 EndIf
DrawingMode(#PB_2DDrawing_Outlined)
Box(1, 1, SpriteWidth(0) - 1,  SpriteHeight(0) - 1, RGB(30,10,5))
StopDrawing()
DisplaySprite(0, (Width / 2) -(SpriteWidth(0) / 2), (Height / 2) -(SpriteHeight(0) / 2))
EndIf
link + 1
ExamineKeyboard()
If KeyboardPushed(#PB_Key_F) And full_screen = 0
 SetRefreshRate(75)
 CloseScreen() : CloseWindow(0) : Delay(100) : OpenScreen(800, 600, 32, "--Fractal Test--") : Delay(100) : full_screen = 1 : Width = 800 : Height = 600
 CreateSprite(0, 400, 400)
EndIf
If KeyboardPushed(#PB_Key_W) And full_screen = 1
 CloseScreen()
 OpenWindow(0, 0, 0, 400, 400, "--Fractal Test--", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
 OpenWindowedScreen(WindowID(0), 0, 0, Width + 1, Height + 1, #False, 0, 0) : full_screen = 0 : Width = 400 : Height = 400
 SetActiveWindow(0)
 CreateSprite(0, 400, 400)
EndIf
If KeyboardPushed(#PB_Key_Escape)
 If IsSprite(0) : FreeSprite(0) : EndIf
 If IsImage(0) : FreeImage(0) : EndIf
 End
EndIf
If link >= 1000000 : link = 10 : EndIf
f + 1
Delay(d)
EndIf
EndProcedure
While WindowEvent() <> #PB_Event_DataReceived : d(0) : Delay(1) : Wend
эээ... вод, написал вместе с "балдой" )

ResX 12.11.2007 12:54
Re: Fractals
 
Вложений: 2
он живой!!! написан мной... :crazy:

Chrono Syndrome 14.11.2007 11:57
Re: Fractals
 
Цитата:
Сообщение от ResX
он живой!!! написан мной... :crazy:
Исходник ?

ResX 14.11.2007 23:43
Re: Fractals
 
Цитата:
Сообщение от Chrono Syndrome
Исходник ?
очень хочется? там же формула приведена lin + 0.0002 : link + 1 каждый кадр

ResX 18.11.2007 07:07
Re: Fractals
 
Вложений: 2
вод ещё один )

Chrono Syndrome 18.11.2007 18:39
Re: Fractals
 
Цитата:
Сообщение от ResX
очень хочется? там же формула приведена lin + 0.0002 : link + 1 каждый кадр
Да не, не очень. Просто не совсем понятно, зачем нужны бесполезные проги без исходников.

ResX 20.11.2007 17:24
Re: Fractals
 
Цитата:
Сообщение от Chrono Syndrome
Да не, не очень. Просто не совсем понятно, зачем нужны бесполезные проги без исходников.
Во всём есть смысл ;)

Chrono Syndrome 21.11.2007 18:41
Re: Fractals
 
Цитата:
Сообщение от ResX
Во всём есть смысл ;)
Ес-но. Но, честно говоря, очень не хотелось бы, чтобы этот смысл заключался в полевых испытаниях нового вируса собственной конструкции или банальном рапространении трояна... Посему нормальные люди не торопятся качать .EXE'шник с одной строчкой малограмотного описания от незнакомого человека. Но это я так, к слову.

ResX 22.11.2007 00:50
Re: Fractals
 
ну-у-у... можно, как бы, доверять ;) код выше есть. я его изменил малость...

kvitaliy 22.11.2007 08:54
Re: Fractals
 
Практически законченная программа, рисующая милионы неповторяющихся узоров, с возможностью сохранения в файл.

Код:
;{ Windows
Enumeration
  #Window_0
  #Window_1
EndEnumeration
;}
;{ Gadgets
Enumeration
  #Timer_0
  #StringGadget_1
  #StringGadget_3
  #StringGadget_4
  #StringGadget_5
  #StringGadget_6
  #StringGadget_7
  #StringGadget_8
  #StringGadget_9
  #StringGadget_10
  #StringGadget_11
  #StringGadget_2
  #ButtonGadget_13
  #ButtonGadget_14
  #ButtonGadget_15
  #ButtonGadget_16
  #ButtonGadget_17
  #ButtonGadget_18
  #ButtonGadget_19
  #ButtonGadget_20
  #ButtonGadget_21
  #ButtonGadget_22
  #ButtonGadget_23
  #ButtonGadget_24
  #ButtonGadget_25
  #ButtonGadget_26
  #CheckBoxGadget_27
  #CheckBoxGadget_28
  #CheckBoxGadget_29
  #CheckBoxGadget_30
  #CheckBoxGadget_31
  #CheckBoxGadget_32
  #CheckBoxGadget_33
  #CheckBoxGadget_34
  #CheckBoxGadget_35
  #CheckBoxGadget_36
  #CheckBoxGadget_37
  #ButtonGadget_38
  #ButtonGadget_39
  #ButtonGadget_40
  #ButtonGadget_41
  #ButtonGadget_42
  #Image_1
  #OptionGadget_0
  #OptionGadget_1
  #OptionGadget_2
  #OptionGadget_3
  #ButtonGadget_100
EndEnumeration
;}
  Global xmax=800;1024
  Global ymax=600;768
 
  Global E.f = 5
  Global F.f = 5
  Global A.f = 1
  Global B.f = 1
  Global C.f = 1
  Global D.f = 1
  Global I.f = 1 / 5
  Global J.f = 1 / 4
  Global K.f = 1 / 4
  Global L.f = 1 / 5
  Global Col_or.l=10000
 
  Global sc.f = 0.25
  Declare Risovat()

;}
Procedure OpenWindow_Window_1()
  If OpenWindow(#Window_1, 484, 221, 235, 167, "Настройка окна", #PB_Window_TitleBar|#PB_Window_ScreenCentered)
    If CreateGadgetList(WindowID(#Window_1))
      OptionGadget(#OptionGadget_0, 15, 15, 100, 25, "800 Х 600")
      OptionGadget(#OptionGadget_1, 15, 45, 335, 20, "1024 Х 768")
      OptionGadget(#OptionGadget_2, 15, 70, 335, 20, "1280 Х 1024")
      OptionGadget(#OptionGadget_3, 15, 100, 330, 20, " Текущее разрешение"):SetGadgetState(#OptionGadget_3,1)
      ButtonGadget(#ButtonGadget_100, 45, 125, 135, 25, "Применить")
    EndIf
  EndIf
EndProcedure

Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 10, 10, xmax, ymax, "Калейдоскоп",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    If CreateGadgetList(WindowID(#Window_0))
      StringGadget(#StringGadget_1, 30, 35, 75, 20, "5")
      StringGadget(#StringGadget_2, 30, 60, 75, 20, "5")
      StringGadget(#StringGadget_3, 30, 85, 75, 20, "1")
      StringGadget(#StringGadget_4, 30, 110, 75, 20, "1")
      StringGadget(#StringGadget_5, 30, 135, 75, 20, "1")
      StringGadget(#StringGadget_6, 30, 160, 75, 20, "1")
      StringGadget(#StringGadget_7, 30, 185, 75, 20, "5")
      StringGadget(#StringGadget_8, 30, 210, 75, 20, "4")
      StringGadget(#StringGadget_9, 30, 235, 75, 20, "4")
      StringGadget(#StringGadget_10, 30, 260, 75, 20,"5")
      StringGadget(#StringGadget_11, 30, 285, 75, 20, "1000")
     
      ButtonGadget(#ButtonGadget_13, 105, 35, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_14, 105, 60, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_15, 105, 85, 50, 20, "1-10")
      ButtonGadget(#ButtonGadget_16, 105, 110, 50, 20, "1-10")
      ButtonGadget(#ButtonGadget_17, 105, 135, 50, 20, "1-10")
      ButtonGadget(#ButtonGadget_18, 105, 160, 50, 20, "1-10")
      ButtonGadget(#ButtonGadget_19, 105, 185, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_20, 105, 210, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_21, 105, 235, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_22, 105, 260, 50, 20, "1-100")
      ButtonGadget(#ButtonGadget_23, 105, 285, 50, 20, "1-1000")
      ButtonGadget(#ButtonGadget_24, 5, 370, 150, 20, "Рисовать!")
      ButtonGadget(#ButtonGadget_25, 5, 5, 150, 20, "Случайно для всех")
      ButtonGadget(#ButtonGadget_26, 5, 405, 150, 20, "Сохранить в файл")
      ButtonGadget(#ButtonGadget_39, 5, 325, 150, 20, "Случайно для отмеченных")
      ButtonGadget(#ButtonGadget_40, 5, 347, 150, 20, "Возврат на исходное")
      ButtonGadget(#ButtonGadget_41, 155, 35, 15, 270, ">")
      ButtonGadget(#ButtonGadget_42, 5, 500, 150, 20, "Авто")
     
      CheckBoxGadget(#CheckBoxGadget_27, 5, 35, 20, 20, ""): SetGadgetState(#CheckBoxGadget_27,1)
      CheckBoxGadget(#CheckBoxGadget_28, 5, 60, 20, 20, ""): SetGadgetState(#CheckBoxGadget_28,1)
      CheckBoxGadget(#CheckBoxGadget_29, 5, 85, 20, 20, "")
      CheckBoxGadget(#CheckBoxGadget_30, 5, 110, 20, 20, "")
      CheckBoxGadget(#CheckBoxGadget_31, 5, 135, 20, 20, "")
      CheckBoxGadget(#CheckBoxGadget_32, 5, 160, 20, 20, "")
      CheckBoxGadget(#CheckBoxGadget_33, 5, 185, 20, 20, ""): SetGadgetState(#CheckBoxGadget_33,1)
      CheckBoxGadget(#CheckBoxGadget_34, 5, 210, 20, 20, ""): SetGadgetState(#CheckBoxGadget_34,1)
      CheckBoxGadget(#CheckBoxGadget_35, 5, 235, 20, 20, ""): SetGadgetState(#CheckBoxGadget_35,1)
      CheckBoxGadget(#CheckBoxGadget_36, 5, 260, 20, 20, ""): SetGadgetState(#CheckBoxGadget_36,1)
      CheckBoxGadget(#CheckBoxGadget_37, 5, 285, 20, 20, "")
     
    EndIf
  EndIf
EndProcedure

OpenWindow_Window_1()
Repeat
 Event = WaitWindowEvent()
  Select Event
    ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #OptionGadget_0
      xmax=800
      ymax=600
      ElseIf EventGadget = #OptionGadget_1
      xmax=1024
      ymax=768
      ElseIf EventGadget = #OptionGadget_2
      xmax=1280
      ymax=1024
      ElseIf EventGadget = #OptionGadget_3
      xmax=DesktopWidth(0)
      ymax=DesktopHeight(0)
      ElseIf EventGadget = #ButtonGadget_100
        If GetGadgetState(#OptionGadget_0)=1
            xmax=800
            ymax=600
            CloseWindow(#Window_1)
            Break
        ElseIf GetGadgetState(#OptionGadget_1)=1
            xmax=1024
            ymax=768
            CloseWindow(#Window_1)
            Break
        ElseIf GetGadgetState(#OptionGadget_2)=1
            xmax=1280
            ymax=1024
            CloseWindow(#Window_1)
            Break
        ElseIf GetGadgetState(#OptionGadget_3)=1
            ExamineDesktops()
            MessageRequester("Калейдоскоп", "Текущее разрешение = "+Str(DesktopWidth(0))+"x"+Str(DesktopHeight(0))+"x"+Str(DesktopDepth(0)))
            xmax=DesktopWidth(0)
            ymax=DesktopHeight(0)
            CloseWindow(#Window_1)
            Break
        EndIf 
      EndIf
    ; //////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_1
        Break
      EndIf
  EndSelect
ForEver

OpenWindow_Window_0()
Procedure Risovat()

      E = ValF(GetGadgetText(#StringGadget_1))
      F = ValF(GetGadgetText(#StringGadget_2))
      A = ValF(GetGadgetText(#StringGadget_3))
      B = ValF(GetGadgetText(#StringGadget_4))
      C = ValF(GetGadgetText(#StringGadget_5))
      D = ValF(GetGadgetText(#StringGadget_6))
      I = 1 / ValF(GetGadgetText(#StringGadget_7))
      J = 1 / ValF(GetGadgetText(#StringGadget_8))
      K = 1 / ValF(GetGadgetText(#StringGadget_9))
      L = 1 / ValF(GetGadgetText(#StringGadget_10))
      Col_or = Val(GetGadgetText(#StringGadget_11))
     
         
      If StartDrawing(WindowOutput(0))
       
For y = 1 To ymax Step 1
    For x = 1 To xmax Step 1
      xx = (x - xmax / 2) * sc: yy = (y - ymax / 2) * sc
      z.f = E * Pow(Sin(A * Sin(i * xx)+ B * Cos(J * yy)),6)+ F * Pow(Cos(c * Cos(K * xx)+ D * Sin(L * yy)),6)
      Col =z * Col_or
      If col>16777215:Col=16777215:EndIf
      Plot(x+170 , y, Col)
    Next x
Next y
   
    StopDrawing()
   
    EndIf

EndProcedure

Procedure OtmRND()
If GetGadgetState(#CheckBoxGadget_28)+GetGadgetState(#CheckBoxGadget_29)+GetGadgetState(#CheckBoxGadget_30)+GetGadgetState(#CheckBoxGadget_31)+GetGadgetState(#CheckBoxGadget_32)+GetGadgetState(#CheckBoxGadget_33)+GetGadgetState(#CheckBoxGadget_34)+GetGadgetState(#CheckBoxGadget_35)+GetGadgetState(#CheckBoxGadget_36)+GetGadgetState(#CheckBoxGadget_37)<1
  MessageRequester("Калейдоскоп", "Нет выбранных параметров для изменения!", #MB_OK|#MB_ICONINFORMATION)
EndIf
If GetGadgetState(#CheckBoxGadget_27)=1:SetGadgetText(#StringGadget_1,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_28)=1:SetGadgetText(#StringGadget_2,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_29)=1:SetGadgetText(#StringGadget_3,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_30)=1:SetGadgetText(#StringGadget_4,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_31)=1:SetGadgetText(#StringGadget_5,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_32)=1:SetGadgetText(#StringGadget_6,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_33)=1:SetGadgetText(#StringGadget_7,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_34)=1:SetGadgetText(#StringGadget_8,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_35)=1:SetGadgetText(#StringGadget_9,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_36)=1:SetGadgetText(#StringGadget_10,StrF(Random(99)+1,1)):EndIf
      If GetGadgetState(#CheckBoxGadget_37)=1:SetGadgetText(#StringGadget_11,StrF(Random(1000)+1,1)):EndIf
      Risovat()
EndProcedure


;{- Event loop
Repeat

  Event = WaitWindowEvent()
  Select Event
    ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #StringGadget_1
   
      ElseIf EventGadget = #ButtonGadget_13
      SetGadgetText(#StringGadget_1,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_14
      SetGadgetText(#StringGadget_2,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_15
      SetGadgetText(#StringGadget_3,StrF(Random(9)+1,1))
      ElseIf EventGadget = #ButtonGadget_16
      SetGadgetText(#StringGadget_4,StrF(Random(9)+1,1))
      ElseIf EventGadget = #ButtonGadget_17
      SetGadgetText(#StringGadget_5,StrF(Random(9)+1,1))
      ElseIf EventGadget = #ButtonGadget_18
      SetGadgetText(#StringGadget_6,StrF(Random(9)+1,1))
      ElseIf EventGadget = #ButtonGadget_19
      SetGadgetText(#StringGadget_7,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_20
      SetGadgetText(#StringGadget_8,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_21
      SetGadgetText(#StringGadget_9,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_22
      SetGadgetText(#StringGadget_10,StrF(Random(100)+1,1))
      ElseIf EventGadget = #ButtonGadget_23
      SetGadgetText(#StringGadget_11,StrF(Random(1000)+1,1))
     
      ElseIf EventGadget = #ButtonGadget_24
      Risovat()
      ElseIf EventGadget = #ButtonGadget_25
      SetGadgetText(#StringGadget_1,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_2,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_3,StrF(Random(10)+1,1))
      SetGadgetText(#StringGadget_4,StrF(Random(10)+1,1))
      SetGadgetText(#StringGadget_5,StrF(Random(10)+1,1))
      SetGadgetText(#StringGadget_6,StrF(Random(10)+1,1))
      SetGadgetText(#StringGadget_7,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_8,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_9,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_10,StrF(Random(100)+1,1))
      SetGadgetText(#StringGadget_11,StrF(Random(1000)+1,1))
     
      ElseIf EventGadget = #ButtonGadget_26
      CreateImage(#Image_1, xmax, ymax)
      StartDrawing(ImageOutput(#Image_1))
      For y = 1 To ymax Step 1
        For x = 1 To xmax Step 1
        xx = (x - xmax / 2) * sc: yy = (y - ymax / 2) * sc
        z.f = E * Pow(Sin(A * Sin(i * xx)+ B * Cos(J * yy)),6)+ F * Pow(Cos(c * Cos(K * xx)+ D * Sin(L * yy)),6)
        Col =z * Col_or
            If col>16777215:Col=16777215:EndIf
        Plot(x+170 , y, Col)
        Next x
    Next y
      StopDrawing()
      FSN:
      StandardFile$ = "picture.bmp" 
  Pattern$ = "BMP (*.bmp);*.bmp"
  Pattern = 0   
  File$ = SaveFileRequester("Выберите файл для записи", StandardFile$, Pattern$, Pattern)
  If Len(File$)>0
        If FileSize(File$)>0
           
          Select MessageRequester("Калейдоскоп", "Файл с таким именем существует. Переписать?", #MB_YESNO|#MB_ICONWARNING|#MB_DEFBUTTON2)
                  Case #IDYES
                  Goto FSD
                  Case #IDNO
                  Goto FSN
          EndSelect
        EndIf 
        FSD:
      SaveImage(#Image_1,File$,#PB_ImagePlugin_BMP)
      MessageRequester("Калейдоскоп", "Выполнено сохранение!", #MB_OK|#MB_ICONINFORMATION)
  Else
      MessageRequester("Калейдоскоп", "Файл не выбран!", #MB_OK|#MB_ICONINFORMATION)
  EndIf 
     
           
      ElseIf EventGadget = #ButtonGadget_39
     
      If GetGadgetState(#CheckBoxGadget_28)+GetGadgetState(#CheckBoxGadget_29)+GetGadgetState(#CheckBoxGadget_30)+GetGadgetState(#CheckBoxGadget_31)+GetGadgetState(#CheckBoxGadget_32)+GetGadgetState(#CheckBoxGadget_33)+GetGadgetState(#CheckBoxGadget_34)+GetGadgetState(#CheckBoxGadget_35)+GetGadgetState(#CheckBoxGadget_36)+GetGadgetState(#CheckBoxGadget_37)<1
          MessageRequester("Калейдоскоп", "Нет выбранных параметров для изменения!", #MB_OK|#MB_ICONINFORMATION)
      EndIf
      If GetGadgetState(#CheckBoxGadget_27)=1:SetGadgetText(#StringGadget_1,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_28)=1:SetGadgetText(#StringGadget_2,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_29)=1:SetGadgetText(#StringGadget_3,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_30)=1:SetGadgetText(#StringGadget_4,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_31)=1:SetGadgetText(#StringGadget_5,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_32)=1:SetGadgetText(#StringGadget_6,StrF(Random(9)+1,1))  :EndIf
      If GetGadgetState(#CheckBoxGadget_33)=1:SetGadgetText(#StringGadget_7,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_34)=1:SetGadgetText(#StringGadget_8,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_35)=1:SetGadgetText(#StringGadget_9,StrF(Random(99)+1,1)) :EndIf
      If GetGadgetState(#CheckBoxGadget_36)=1:SetGadgetText(#StringGadget_10,StrF(Random(99)+1,1)):EndIf
      If GetGadgetState(#CheckBoxGadget_37)=1:SetGadgetText(#StringGadget_11,StrF(Random(1000)+1,1)):EndIf
     
      ElseIf EventGadget = #ButtonGadget_40
     
        SetGadgetText(#StringGadget_1, "5")
        SetGadgetText(#StringGadget_2, "5")
        SetGadgetText(#StringGadget_3, "1")
        SetGadgetText(#StringGadget_4, "1")
        SetGadgetText(#StringGadget_5, "1")
        SetGadgetText(#StringGadget_6, "1")
        SetGadgetText(#StringGadget_7, "5")
        SetGadgetText(#StringGadget_8, "4")
        SetGadgetText(#StringGadget_9, "4")
        SetGadgetText(#StringGadget_10,"5")
        SetGadgetText(#StringGadget_11,"10000")
       
      ElseIf EventGadget = #ButtonGadget_41
          Risovat()
      ElseIf EventGadget = #ButtonGadget_42
        If GetGadgetText(#ButtonGadget_42) = "Авто"
          SetGadgetText(#ButtonGadget_42,"Стоп Авто")
          DisableGadget(#ButtonGadget_26, 1)
          OtmRND()
          StartTimer( #Timer_0 , 5000 , @OtmRND() )
        Else
          SetGadgetText(#ButtonGadget_42,"Авто")
          DisableGadget(#ButtonGadget_26, 0)
          EndTimer( #Timer_0 )
        EndIf
      ElseIf EventGadget = #ButtonGadget_100
      ExamineDesktops()
        MessageRequester("Display Information", "Current resolution = "+Str(DesktopWidth(0))+"x"+Str(DesktopHeight(0))+"x"+Str(DesktopDepth(0)))
      CloseWindow(#Window_1)
       
      EndIf
    ; //////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
      EndTimer( #Timer_0 )
        Break
      EndIf
  EndSelect
ForEver
;}

Chrono Syndrome 25.11.2007 19:23
Re: Fractals
 
Код:
InitSprite()
OpenWindow(0, 0, 0, 800, 600, "--Fractal Test--", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
Define Width = WindowWidth(0) - 1, Height = WindowHeight(0) - 1, X, Y
Define I = 1
OpenWindowedScreen(WindowID(0), 0, 0, Width + 1, Height + 1, #False, 0, 0)
While WindowEvent() <> #PB_Event_CloseWindow
StartDrawing(ScreenOutput())
For X = 0 To Width
For Y = 0 To Height
;--Fractal[--;
Plot(X, Y, X & Y * I)
;--]Fractal--;
Next Y
Next X
StopDrawing()
FlipBuffers()
If I < 0 : I = 0 : Else : I + 1 : EndIf
Wend
Гипнотизирует, однако)...


Часовой пояс GMT +4, время: 06:31.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Перевод: zCarot