Тема: Fractals
Показать сообщение отдельно
Старый 26.01.2007, 10:50   #4
kvitaliy
Оператор ЭВМ
 
Регистрация: 10.01.2007
Сообщений: 37
Написано 6 полезных сообщений
(для 5 пользователей)
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
(Offline)
 
Ответить с цитированием