Page 1 of 1
This is just a try but BubbleSort (with graphics)
Posted: Sat Apr 11, 2009 11:05 pm
by michaeled314
Code: Select all
Dim sort.l(1000)
For i = 1 To 1000
sort(i) = Random(1000)
Next
writes.l
times.l = 0
If OpenWindow(0,0,0,1000,1000,"Sort",#PB_Window_ScreenCentered)
hWnd = WindowID(0)
hDC = GetDC_(hWnd)
hBrush = CreateSolidBrush_(RGB(0,0,0))
Debug hBrush
Repeat
Delay(10)
writes = 0
times+1
StartDrawing(WindowOutput(0))
Box(0,0,1000,1000,RGB(255,255,255))
StopDrawing()
For i = 2 To 1000
If sort(i) < sort(i-1)
a = sort(i)
sort(i) = sort(i-1)
sort(i-1) = a
writes+1
EndIf
Next
For i = 2 To 1000
StartDrawing(WindowOutput(0))
BackColor(RGB(255,255,255))
Box(i-1,0,1,sort(i-1),RGB(0,0,0))
StopDrawing()
Next
Until Not writes
EndIf
Posted: Sat Apr 11, 2009 11:55 pm
by Demivec
Try this small change to remove the flicker:
Code: Select all
Dim sort.l(1000)
For i = 1 To 1000
sort(i) = Random(1000)
Next
writes.l
times.l = 0
If OpenWindow(0,0,0,1000,1000,"Sort",#PB_Window_ScreenCentered)
hwnd = WindowID(0)
hdc = GetDC_(hwnd)
hBrush = CreateSolidBrush_(RGB(0,0,0))
Debug hBrush
Repeat
Delay(10)
writes = 0
times+1
; StartDrawing(WindowOutput(0))
; Box(0,0,1000,1000,RGB(255,255,255))
; StopDrawing()
For i = 2 To 1000
If sort(i) < sort(i-1)
a = sort(i)
sort(i) = sort(i-1)
sort(i-1) = a
writes+1
EndIf
Next
For i = 2 To 1000
StartDrawing(WindowOutput(0))
BackColor(RGB(255,255,255))
Box(i-1,0,1,sort(i-1),RGB(0,0,0))
Box(i-1,sort(i-1) + 1,1,1000,RGB(255,255,255))
StopDrawing()
Next
Until Not writes
EndIf
Posted: Sun Apr 12, 2009 12:45 am
by michaeled314
Code: Select all
Dim sort.l(1000)
For i = 1 To 1000
sort(i) = Random(1000)
Next
writes.l
times.l = 0
If OpenWindow(0,0,0,1000,1000,"Sort",#PB_Window_ScreenCentered)
hwnd = WindowID(0)
hdc = GetDC_(hwnd)
hBrush = CreateSolidBrush_(RGB(0,0,0))
Repeat
Delay(10)
writes = 0
times+1
; StartDrawing(WindowOutput(0))
; Box(0,0,1000,1000,RGB(255,255,255))
; StopDrawing()
For i = 2 To 1000
If sort(i) < sort(i-1)
a = sort(i)
sort(i) = sort(i-1)
sort(i-1) = a
writes+1
EndIf
Next
For i = 2 To 1000
StartDrawing(WindowOutput(0))
BackColor(RGB(255,255,255))
Box(0,i-1,sort(i-1),1,RGB(0,0,0))
Box(sort(i-1)+1,i-1,1000,1,RGB(255,255,255))
StopDrawing()
Next
Until Not writes
EndIf
horizontally
Posted: Mon Apr 20, 2009 10:43 am
by kinglestat
Since qbasic I liked graphical sort. well done. I modified it a bit
Code: Select all
Dim sort.l(1000)
#LINES = 200
#WIDTH = 5
For i = 1 To #LINES
sort(i) = Random(1000)
Next
writes.l
times.l = 0
If OpenWindow(0,0,0,1000,1000,"Sort",#PB_Window_ScreenCentered)
hwnd = WindowID(0)
hdc = GetDC_(hwnd)
hBrush = CreateSolidBrush_(RGB(255,0,0))
Repeat
Delay(10)
writes = 0
times+1
; StartDrawing(WindowOutput(0))
; Box(0,0,1000,1000,RGB(255,255,255))
; StopDrawing()
For i = 2 To #LINES
If sort(i) < sort(i-1)
a = sort(i)
sort(i) = sort(i-1)
sort(i-1) = a
writes+1
EndIf
Next
For i = 2 To #LINES
StartDrawing(WindowOutput(0))
BackColor(RGB(255,255,255))
Box(0,(i-1)*4,sort(i-1),#WIDTH,RGB(255,0,0))
Box(sort(i-1)+1,(i-1)*4,1000,#WIDTH,RGB(255,255,255))
StopDrawing()
Next
Until Not writes
EndIf
Delay( 1000 )