'================================================================
'= ソートテスト
'=    (Sort2.bas)
'================================================================
#include "Windows.bi"

Var Shared Edit1 As Object
Var Shared Text1 As Object
Var Shared List(1) As Object
Var Shared Button1 As Object

For i = 0 To 1
    List(i).Attach GetDlgItem("List" & Trim$(Str$(i + 1))) : List(i).SetFontSize 14
Next
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared dMax As Long
Var Shared d(100000) As Long

'================================================================
'= Sort部
'================================================================
Declare Sub Sort ()
Sub Sort()
    If dMax Mod 2 = 0 Then SF = dMax Else SF = dMax + 1
    Dim Ls(SF/2), Rs(SF/2)

    k = 0 : l = 1 : r = dMax
    *Jp0
    i = l : j = r : t = d((l + r) / 2)
    *Jp1
    If d(i) < t Then i = i + 1 : Goto *Jp1
    *Jp2
    If t < d(j) Then j = j - 1 : Goto *Jp2
    If i < j Then Swap d(i), d(j) : i = i + 1 : j = j - 1 : Goto *Jp1
    If i = j Then i = i + 1 : j = j - 1
    If l >= j Then *Jp3
    If i < r Then Ls(k) = l : Rs(k) = j : k = k + 1 : l = i : Goto *Jp0
     r = j : Goto *Jp0
    *Jp3
    If i < r Then l = i : Goto *Jp0
    k = k - 1
    If k >= 0 Then l = Ls(k) : r = Rs(k) : Goto *Jp0

    Erase LS, RS
End Sub

'================================================================
'=　
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    dMax = Val(GetDlgItemText("Edit1"))
    If dMax < 2 Or dMax > 100000 Then
        Edit1.SetWindowText ""
        Edit1.SetFocus
        Exit Sub
    End If

    SetMousePointer 2
    List(0).Resetcontent
    List(1).Resetcontent

    For CT = 1 To dMax
        d(CT) = Rnd(1) * dMax
        List(0).AddString Format$(d(CT)," ###,###")
    Next

    Sort

    For CT = 1 To dMax
        List(1).AddString Format$(d(CT)," ###,###")
    Next

    SetMousePointer 0
End Sub

'================================================================
'=　
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    List(0).Resetcontent
    List(1).Resetcontent
End Sub

'================================================================
'=　
'================================================================
While 1
    WaitEvent
Wend
Stop
End