Restored from previous forum. Originally posted by fweil.
Hope some of you like Mandelbrot fractal ...
;================================================================
;
; F.Weil - 20020905
;
; This Mandelbrot drawing is a case study to manage a scrolling drawing window.
;
; User features are given in menus and added shortcuts :
;
; W to update window size to image size (limitation to 1024 x 768 screen
; B to save the bitmap in a file (BMP only ! )
;
; The interesting featuer for me is the callback procedure handling scrollbars.
;
; The program is not perfect (some bugs in image / window sizing) but works rather well.
;
; As it is a simplified version of the original program, you will not find the possibility to
; zoom - unzoom or select any part of the drawing ...
;
; Just a case study for scrolling a drawing window I said !
;
;
#background = $3C1E1E
hWnd.l
HScrollLevel.l
VScrollLevel.l
OldHScrollLevel.l
OldVScrollLevel.l
ImageXPosition.l
ImageYPosition.l
WindowXSize.l
WindowYSize.l
ImageXSize.l
ImageYSize.l
ImageID0.l
xmin.f
ymin.f
xmax.f
ymax.f
Global HScrollLevel, VScrollLevel, OldHScrollLevel, OldVScrollLevel, ImageXPosition, ImageYPosition, WIndowXSize, WindowYSize, ImageXSize, ImageYSize
Global hWnd, ImageID0
Global xmin, ymin, xmax, ymax
Procedure.l IMin(a.l, b.l)
If b a
ProcedureReturn b
Else
ProcedureReturn a
EndIf
EndProcedure
Procedure RedrawScreen()
StartDrawing(WindowOutput())
Box(0, 0, WindowXSize, WindowYSize, #background)
DrawImage(ImageID0, ImageXPosition, ImageYPosition)
StopDrawing()
ProcedureReturn
EndProcedure
Procedure MyDrawImage(NIter, FontID)
FreeImage(0)
If CreateImage(0, ImageXSize, ImageYSize)
ImageID0 = ImageID()
EndIf
StartDrawing(ImageOutput())
DrawingFont(FontID)
Box(0, 0, ImageXSize, ImageYSize, #background)
n.l = NIter
nx.l = ImageXSize
ny.l = ImageYSize
c.f = (xmax - xmin) / nx
d.f = (ymax - ymin) / ny
For j.l = 0 To ny
b.f = ymin + j * d
For i.l = 0 To nx
a.f = xmin + i * c
x.f = a
y.f = b
For k.l = 0 To n
u.f = x * x
v.f = y * y
y.f = 2 * x * y + b
x.f = u - v + a
If (u + v) > n
Goto Label1
EndIf
Next k
Label1:
col.l = 256 * k / n
Color = col OldHScrollLevel
OldHScrollLevel = HScrollLevel
ImageXPosition = (HScrollLevel / 100) * (WindowXSize - ImageXSize) / 65536
EndIf
RedrawScreen()
SetScrollPos_(WindowID, #SB_HORZ, HScrollLevel / 65536, #TRUE)
Case #WM_VSCROLL ; Vertical Scroll features
Select wParam
Case 0 ; Scroll up button
VScrollLevel = IMax(VScrollLevel - 10000, 0)
Case 1 ; Scroll down button
VScrollLevel = IMin(VScrollLevel + 10000, 6553600)
Case 2 ; Scroll page up
VScrollLevel = IMax(VScrollLevel - 1000000, 0)
Case 3 ; Scroll page down
VScrollLevel = IMin(VScrollLevel + 1000000, 6553600)
Case 8
Default
VScrollLevel = wParam
EndSelect
If VScrollLevel OldVScrollLevel
OldVScrollLevel = VScrollLevel
ImageYPosition = (VScrollLevel / 100) * (WindowYSize - ImageYSize) / 65536
EndIf
RedrawScreen()
SetScrollPos_(WindowID, #SB_VERT, VScrollLevel / 65536, #TRUE)
Case #WM_PAINT ;
RedrawScreen()
Case #WM_SIZE ; Window size gadget used
If WindowID = hWnd
If WindowXSize WindowWidth() Or WindowYSize WindowHeight() - 40
WindowXSize = WindowWidth()
WindowYSize = WindowHeight() - 40
EndIf
RedrawScreen()
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
;
; Main starts here
;
WID.l
WEvent.l
EventMenu.l
Quit.l
FontID.l
FileName.s
NIter.l
Quit = #FALSE
WindowXSize = 320
WindowYSize = 240
ImageXSize = 320
ImageYSize = 240
NIter = 100
xmin.f = -2.2
xmax.f = 1
ymin.f = -1.2
ymax.f = 1.2
hWnd = OpenWindow(0, (GetSystemMetrics_(#SM_CXSCREEN) - WindowXSize) / 2, (GetSystemMetrics_(#SM_CYSCREEN) - WindowYSize) / 2, WindowXSize, WindowYSize + 40, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #WS_VSCROLL | #WS_HSCROLL, "Mandelbrot fractal")
If hWnd
AddKeyboardShortcut(0, #PB_Shortcut_B, 102)
AddKeyboardShortcut(0, #PB_Shortcut_W, 123)
AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
LoadFont(0, "Arial", 7)
FontID = FontID()
If CreateMenu(0, WindowID())
OpenSubMenu("Main")
MenuItem( 1, "New")
MenuItem(120, "Save image")
MenuItem( 99, "Quit")
CloseSubMenu()
OpenSubMenu("Size")
MenuItem( 10, " 160 x 120")
MenuItem( 11, " 320 x 240")
MenuItem( 12, " 640 x 480")
MenuItem( 13, " 800 x 600")
MenuItem( 14, "1024 x 768")
MenuItem( 15, "1280 x 960")
MenuItem( 16, "3200 x 2400")
MenuItem( 17, "4000 x 3000")
CloseSubMenu()
OpenSubMenu("Iterations")
MenuItem( 20, " 100")
MenuItem( 21, " 250")
MenuItem( 22, " 1000")
MenuItem( 23, " 5000")
MenuItem( 24, "10000")
CloseSubMenu()
EndIf
SetWindowCallback(@MyWindowCallBack())
If CreateImage(0, ImageXSize, ImageYSize)
ImageID0 = ImageID()
EndIf
MyDrawImage(NIter, FontID)
Repeat
WID = WindowID()
WEvent = WaitWindowEvent()
EventType = EventType()
Select WEvent
Case #PB_EventCloseWindow
Quit = #TRUE
Case #PB_EventMenu
EventMenu = EventMenuID()
Select EventMenu
Case 1
ImageXSize = 320
ImageYSize = 240
WindowXSize = 320
WindowYSize = 240
NIter = 100
xmin.f = -2.2
xmax.f = 1
ymin.f = -1.2
ymax.f = 1.2
MyDrawImage(NIter, FontID)
Case 10
ImageXSize = 160
ImageYSize = 120
MyDrawImage(NIter, FontID)
Case 11
ImageXSize = 320
ImageYSize = 240
MyDrawImage(NIter, FontID)
Case 12
ImageXSize = 640
ImageYSize = 480
MyDrawImage(NIter, FontID)
Case 13
ImageXSize = 800
ImageYSize = 600
MyDrawImage(NIter, FontID)
Case 14
ImageXSize = 1024
ImageYSize = 768
MyDrawImage(NIter, FontID)
Case 15
ImageXSize = 1280
ImageYSize = 960
MyDrawImage(NIter, FontID)
Case 16
ImageXSize = 3200
ImageYSize = 2400
MyDrawImage(NIter, FontID)
Case 17
ImageXSize = 4000
ImageYSize = 3000
MyDrawImage(NIter, FontID)
Case 20
NIter = 100
MyDrawImage(NIter, FontID)
Case 21
NIter = 250
MyDrawImage(NIter, FontID)
Case 22
NIter = 1000
MyDrawImage(NIter, FontID)
Case 23
NIter = 5000
MyDrawImage(NIter, FontID)
Case 24
NIter = 10000
MyDrawImage(NIter, FontID)
Case 99
Quit = #TRUE
Case 102
FileName = SaveFileRequester("Choose a file name", "C:\*.bmp", "", 0)
If FileName ""
SaveImage(0, FileName)
EndIf
Case 123
ResizeWindow(IMin(ImageXSize, 1024), IMin(ImageYSize + 40, 768))
Default
EndSelect
Default
EndSelect
Until Quit
EndIf
End
;================================================================
Francois Weil
14, rue Douer
F64100 Bayonne
Smple sample app with scrolling window
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by MrVainSCL.
Hi fweil
Nice old skool example with scrolling window... I found a small bug/problem with your source... Resize the opened window smaller as the orgignal opened and try then to scroll the fracatal image... Maybe you will see the same problem like on my machine!? You can only scroll a part of the image but not the full image... some parts will be not or wrong updatet... Else, if the window is bigger as the image it works fine here...
PIII450, 256MB Ram, 6GB HD, RivaTNT, DirectX8.1, SB AWE64, Win2000 + all Updates...
greetz
MrVainSCL! aka Thorsten
Hi fweil
Nice old skool example with scrolling window... I found a small bug/problem with your source... Resize the opened window smaller as the orgignal opened and try then to scroll the fracatal image... Maybe you will see the same problem like on my machine!? You can only scroll a part of the image but not the full image... some parts will be not or wrong updatet... Else, if the window is bigger as the image it works fine here...
PIII450, 256MB Ram, 6GB HD, RivaTNT, DirectX8.1, SB AWE64, Win2000 + all Updates...
greetz
MrVainSCL! aka Thorsten
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by chr1sb.
Sorry that I'm going a bit off-topic here but mandelbrot fans should see this realtime fractal zooming program:
http://xaos.theory.org/
I only saw this recently and was amazed (last time I explored the mandelbrot set was DOS Fractint on a 66Mhx 486DX2)
chr1sb
Sorry that I'm going a bit off-topic here but mandelbrot fans should see this realtime fractal zooming program:
http://xaos.theory.org/
I only saw this recently and was amazed (last time I explored the mandelbrot set was DOS Fractint on a 66Mhx 486DX2)
chr1sb
-
BackupUser
- PureBasic Guru
- Posts: 16777133
- Joined: Tue Apr 22, 2003 7:42 pm
Restored from previous forum. Originally posted by fweil.
Hey Chr1sb I was not preparing myself for doing like Xaos now ... maybe later.
I will first try to solve the scroll bug you mentioned MrVainSCL and post an update when ready.
If in the meanwhile anybody wants to participate to PureBasicForge !!!
KRgrds
Francois Weil
14, rue Douer
F64100 Bayonne
Hey Chr1sb I was not preparing myself for doing like Xaos now ... maybe later.
I will first try to solve the scroll bug you mentioned MrVainSCL and post an update when ready.
If in the meanwhile anybody wants to participate to PureBasicForge !!!
KRgrds
Francois Weil
14, rue Douer
F64100 Bayonne