This is just a try but BubbleSort (with graphics)

michaeled314 · Post by **michaeled314** » Sat Apr 11, 2009 11:05 pm

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

Demivec · Post by **Demivec** » Sat Apr 11, 2009 11:55 pm

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

michaeled314 · Post by **michaeled314** » Sun Apr 12, 2009 12:45 am

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

kinglestat · Post by **kinglestat** » Mon Apr 20, 2009 10:43 am

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 )