Bubble Sort Multiple Arrays at Same Time

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
#Include "Win32API.inc"
Global hDlg As Dword
Global A(),B(),C(),D() As String
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   BuildArrays
   Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
   If Cb.Msg = %WM_Command And Cb.Ctl = 100 And Cb.CtlMsg = %BN_Clicked Then
      BubbleSort C(),B(),D(),A()  '<--- order of 2nd/3rd/4th element not important
      ? Join$(A(),"") + $CrLf + Join$(B(),"") + $CrLf + Join$(C(),"") + $CrLf + Join$(D(),"")
   End If
End Function
 
Sub BuildArrays
   ReDim A(2),B(2),C(2),D(2)
   A(0)="1" : A(1) = "2" :  A(2)="3"
   B(0)="C" : B(1) = "A" :  B(2)="B"
   C(0)="10": C(1) = "9" :  C(2)="8"
   D(0)="R" : D(1) = "S" :  D(2)="T
End Sub
 
Sub BubbleSortA(X() As String, R() As String, S() As String, T() As String)
   Local i,j As Long
   For i = 0 To UBound(X)-1
      For j = 0 To UBound(X)-1-i
         If X(j) < X(j+1) Then
            Swap X(j), X(J+1)
            Swap R(j), R(j+1)
            Swap S(j), S(j+1)
            Swap T(j), T(j+1)
         End If
      Next j
   Next j
End Sub
 
Sub BubbleSortC(X() As String, R() As String, S() As String, T() As String)
   Local i,j As Long
   For i = 0 To UBound(X)
      For j = 0 To UBound(X)-1
         If X(j) < X(j+1) Then Swap X(j), X(J+1) : Swap R(j), R(j+1) : Swap S(j), S(j+1) : Swap T(j), T(j+1)
         End If
      Next j
   Next j
End Sub
 
Sub BubbleSortB(X() As String, R() As String, S() As String, T() As String)
    Dim i,j,t  As Long
    For i = UBound(X) To 0 Step -1
      For j = 0 To i - 1
          If X(j) <  X(j+1) Then Swap X(j), X(j+1)
      Next j
    Next i
End Sub  
 
'gbs_01212
'Date: 05-11-2013   

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm