Исследование методов сортировки массивов: Ошибка в работе программы

Private Sub BinarIns_Click()
 
frmSchemeBinar.Show vbModal
 
End Sub
 
Private Sub MDIForm_Load()
 
 Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
 
 Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
 
 Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
 
 Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
 
 LoadNewDoc
 
End Sub
 
Private Sub LoadNewDoc()
 
 Static lDocumentCount As Long
 
 Dim frmD As frmDocument
 
 lDocumentCount = lDocumentCount + 1
 
 Set frmD = New frmDocument
 
 frmD.Caption = "Document " & lDocumentCount
 
 frmD.Show
 
End Sub
 
Private Sub MDIForm_Unload(Cancel As Integer)
 
 If Me.WindowState <> vbMinimized Then
 
 SaveSetting App.Title, "Settings", "MainLeft", Me.Left
 
 SaveSetting App.Title, "Settings", "MainTop", Me.Top
 
 SaveSetting App.Title, "Settings", "MainWidth", Me.Width
 
 SaveSetting App.Title, "Settings", "MainHeight", Me.Height
 
 End If
 
End Sub
 
Private Sub mnuinformationdescribe_Click()
 
 frmInformation.Show vbModal
 
End Sub
 
Private Sub mnugrafikgraph_Click()
 
 frmGraph.Show vbModal
 
End Sub
 
Private Sub mnugrafikillustration_Click()
 
 frmIllustration.Show vbModal
 
End Sub
 
Private Sub mnusortsimple_Click()
 
 frmSimple.Show vbModal
 
End Sub
 
Private Sub mnusortbinar_Click()
 
 frmBinar.Show vbModal
 
End Sub
 
Private Sub mnuFileSaveAs_Click()
 
 Dim sFile As String
 
 
 If ActiveForm Is Nothing Then Exit Sub
 
 
 With dlgCommonDialog
 
 .DialogTitle = "Save As"
 
 .CancelError = False
 
 'ToDo: set the flags and attributes of the common dialog control
 
 .Filter = "All Files (*.*)|*.*"
 
 .ShowSave
 
 If Len(.FileName) = 0 Then
 
 Exit Sub
 
 End If
 
 sFile = .FileName
 
 End With
 
 ActiveForm.Caption = sFile
 
 ActiveForm.rtfText.SaveFile sFile
 
End Sub
 
Private Sub SimpleIns_Click()
 
frmSchemeSimple.Show vbModal
 
End Sub
 
Private Sub Tree_Click()
 
 frmTree.Show vbModal
 
End Sub
 
Ìîäóëü frmDocument
 
Private Sub Form_Load()
 
 Dim s As String
 
s = "ÔÅÄÅÐÀËÜÍÎÅ ÀÃÅÍÑÒÂÎ ÏÎ ÎÁÐÀÇÎÂÀÍÈÞ" & vbCrLf
 
s = s & "ÃÎÑÓÄÀÐÑÒÂÅÍÍÎÅ ÎÁÐÀÇÎÂÀÒÅËÜÍÎÅ Ó×ÅÐÅÆÄÅÍÈÅ ÂÛÑØÅÃÎ ÏÐÎÔÅÑÑÈÎÍÀËÜÍÎÃÎ ÎÁÐÀÇÎÂÀÍÈß" & vbCrLf
 
s = s & "ÓÔÈÌÑÊÈÉ ÃÎÑÓÄÀÐÑÒÂÅÍÍÛÉ ÀÂÈÀÖÈÎÍÍÛÉ ÒÅÕÍÈ×ÅÑÊÈÉ ÓÍÈÂÅÐÑÈÒÅÒ"
 
s = s & vbCrLf & vbCrLf & "êóðñîâàÿ ðàáîòà íà òåìó:" & vbCrLf
 
s = s & "ÈÑÑËÅÄÎÂÀÍÈÅ ÌÅÒÎÄÎÂ ÑÎÐÒÈÐÎÂÊÈ ÌÀÑÑÈÂÎÂ" & vbCrLf & vbCrLf
 
s = s & "Àâòîð ïðîãðàììû ñòóäåíò ãðóïïû ÑÏ-155" & vbCrLf
 
s = s & "ÃÀÐÈÔÓËËÈÍ Ð.Ð." & vbCrLf & vbCrLf
 
s = s & "ÓÔÀ 2007."
 
Label1.Caption = s: s = ""
 
End Sub
 
Ìîäóëü frmSimple
 
Option Explicit
 
Dim msfg As MSFlexGrid, sctm10 As Integer
 
Private Sub btOk_Click()
 
Unload Me
 
End Sub
 
Private Sub Form_Load()
 
Set msfg = Me.MSFlexGrid1
 
msfg.FixedRows = 1: Col_Rownomer: RowColsAvto
 
msfg.TextMatrix(0, 1) = "Èñõîäíûé"
 
msfg.TextMatrix(0, 2) = "Ñîðòèðîâàííûé"
 
End Sub
 
Private Sub Form_Close()
 
 sctm10 = 0
 
End Sub
 
Private Sub Form_Activate()
 
 Text1.SetFocus
 
End Sub
 
Public Sub Col_Rownomer()
 
Dim i As Integer
 
For i = 0 To (msfg.Rows - 1)
 
msfg.TextMatrix(i, 0) = i
 
Next i
 
i = 0
 
msfg.ColWidth(i) = 480
 
For i = 1 To (msfg.Cols - 1)
 
msfg.TextMatrix(0, i) = i
 
msfg.ColWidth(i) = 960
 
Next i
 
End Sub
 
Public Sub RowColsAvto()
 
Dim i As Long
 
For i = 0 To msfg.Rows - 1
 
 msfg.RowHeight(i) = 240
 
Next i
 
For i = 1 To msfg.Cols - 1
 
 msfg.ColWidth(i) = 1300
 
Next i
 
End Sub
 
Private Sub btAdd_Click()
 
Dim x As Long
 
On Error GoTo Handler
 
If IsNumeric(Text1.Text) Then
 
 x = CLng(Text1.Text)
 
 If x > 0 And x <= 100 Then
 
 sctm10 = sctm10 + 1
 
 m10(sctm10) = x
 
 msfg.TextMatrix(sctm10, 1) = x
 
 If sctm10 = UBound(m10) Then
 
 btAdd.Enabled = False
btInsert.Enabled = True
 
 End If
 
 End If
 
End If
 
Handler:
 
If Err.Number <> 0 Then
 
 Err.Clear
 
End If
 
Text1 = ""
 
Text1.SetFocus
 
End Sub
 
Private Sub btInsert_Click()
 
Dim i As Integer
 
InsertionSort m10, UBound(m10)
 
For i = LBound(m10) To UBound(m10)
 
 msfg.TextMatrix(i, 2) = m10(i)
 
Next i
 
End Sub
 
Ìîäóëü frmBinar
 
Option Explicit
 
Dim msfg As MSFlexGrid, sctm10 As Integer
 
Private Sub btOk_Click()
 
Unload Me
 
End Sub
 
Private Sub Form_Load()
 
Set msfg = Me.MSFlexGrid1
 
msfg.FixedRows = 1: Col_Rownomer: RowColsAvto
 
msfg.TextMatrix(0, 1) = "Èñõîäíûé"
 
msfg.TextMatrix(0, 2) = "Ñîðòèðîâàííûé"
 
End Sub
 
Private Sub Form_Activate()
 
 Text1.SetFocus
 
End Sub
 
Private Sub GistoGramma()
 
Dim i As Double, j As Long, k As Double
 
Dim t As Double '"øàã ïîñòðîåíèÿ"
 
Dim ta As Double '"òåêóùèé àðãóìåíò"
 
Dim x0 As Double, y0 As Double, x1 As Double, y1 As Double
 
Dim xcnt As Double, ycnt As Double, vpole As Double, gpole As Double
 
Dim shag_x As Double, shag_y As Double, Tmp As Double
 
Dim dzsy As Double, dzsx As Double
 
Dim ymax As Double
 
On Error GoTo HandlerError
 
Picture1.Cls
 
Rem "óñòàíàâëèâàåì ìàñøòàá ïî îñè X"
 
Picture1.ScaleWidth = 24
 
gpole = 2
 
shag_x = 2
 
'Picture1.ScaleHeight = upperbound * 1.2: vpole = upperbound * 0.1
 
Picture1.ScaleHeight = 120: vpole = 10
 
xcnt = gpole: ycnt = Picture1.ScaleHeight - vpole
 
Rem "ðèñóåì êîîðäèíàòíûå ëèíèè"
 
Picture1.Line (0, ycnt)-(Picture1.ScaleWidth, ycnt)
 
Picture1.Line (xcnt, 0)-(xcnt, Picture1.ScaleHeight)
 
Picture1.CurrentX = Picture1.ScaleWidth * 0.9
 
Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.04
 
Picture1.Print "Èíäåêñ"
 
Picture1.CurrentX = xcnt + dzsx
 
Picture1.CurrentY = 0.005 * Picture1.ScaleHeight
 
Picture1.Print "Çíà÷åíèå ýëåìåíòà"
 
Rem "ðèñîâàíèå ýëåìåíòîâ ãèñòîãðàììû"
 
i = xcnt
 
k = xcnt - 1
 
For j = LBound(m10) To UBound(m10)
 
 i = i + 2
 
 k = k + 2
 
 Picture1.CurrentX = i - 1
 
 Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.005
 
 Picture1.Print m10(j)
 
 Picture1.ForeColor = QBColor(10)
 
 Picture1.Line (k, ycnt)-(k + 1.5, ycnt - m10(j)), , BF
 
 Picture1.ForeColor = QBColor(0)
 
Next j
 
HandlerError:
 
If Err <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Private Sub Col_Rownomer()
 
Dim i As Integer
 
For i = 0 To (msfg.Rows - 1)
 
msfg.TextMatrix(i, 0) = i
 
Next i
 
i = 0
 
msfg.ColWidth(i) = 480
 
For i = 1 To (msfg.Cols - 1)
 
msfg.TextMatrix(0, i) = i
 
msfg.ColWidth(i) = 960
 
Next i
 
End Sub
 
Private Sub RowColsAvto()
 
Dim i As Long
 
For i = 0 To msfg.Rows - 1
 
 msfg.RowHeight(i) = 240
 
Next i
 
For i = 1 To msfg.Cols - 1
 
 msfg.ColWidth(i) = 1300
 
Next i
 
End Sub
 
Private Sub btAdd_Click()
 
Dim x As Long
 
On Error GoTo Handler
 
If IsNumeric(Text1.Text) Then
 
 x = CLng(Text1.Text)
 
 If x > 0 And x <= 100 Then
 
 sctm10 = sctm10 + 1
 
 m10(sctm10) = x
 
 msfg.TextMatrix(sctm10, 1) = x
 
 If sctm10 = UBound(m10) Then
 
 btAdd.Enabled = False
 
 btBinar.Enabled = True
 
 End If
 
 End If
 
End If
 
Handler:
 
If Err.Number <> 0 Then
 
 Err.Clear
 
End If
 
Text1 = ""
 
Text1.SetFocus
 
End Sub
 
Private Sub btBinar_Click()
 
Dim i As Integer
 
BinaryInsertionSort m10, UBound(m10)
 
For i = LBound(m10) To UBound(m10)
 
 msfg.TextMatrix(i, 2) = m10(i)
 
Next i
 
GistoGramma
 
Handler:
 
If Err.Number <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Ìîäóëü frmInformation
 
Private Sub btOk_Click()
 
Unload Me
 
End Sub
 
Private Sub Form_Load()
 
Dim f As String, s As String
 
f = App.Path & "\" & "metod.txt"
 
Open f For Input As #1
 
Text1 = ""
 
Do While Not EOF(1)
 
 Line Input #1, s
 
 Text1 = Text1 & s & vbCrLf
 
Loop
 
Close #1
 
End Sub
 
 
 
Option Explicit
 
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
 
Private Const ResultFile As String = "Result.txt"
 
Private Const NameMtd1 As String = "Ìåòîä ïðîñòûõ âñòàâîê"
 
Private Const NameMtd2 As String = "Ìåòîä áèíàðíûõ âñòàâîê"
 
Private Const StartVal = 500
 
Private Const EndVal = 5000
 
Private Const shag = 50
 
Private Const MaxEndVal = 5000
 
Dim J_Max As Integer
 
Dim indcancel As Boolean '"íàæàòèå îòìåíû"
 
Dim m10(1 To 10) As Long
 
Dim m5000(1 To 5000) As Long
 
Private Type grfpnt
 
 x As Single
 
 y As Single
 
End Type
 
Dim mpnt1(0 To 90) As grfpnt '"ìàññèâ òî÷åê 1 ãðàôèêà"
 
Dim mpnt2(0 To 90) As grfpnt '"ìàññèâ òî÷åê 2 ãðàôèêà"
 
Dim timeMax As Double '"ìàêñ. âðåìÿ ñîðòèðîâêè"
 
Dim sctm10 As Integer
 
Dim vs As Single '"òåêóùåå âðåìÿ ñîðòèðîâêè"
 
Private Sub btOk_Click()
 
Unload Me
 
End Sub
 
Private Sub CmdGrafik_Click()
 
Dim i As Integer, tm As Single, j As Integer
 
Dim k As Integer
 
On Error GoTo Handler
 
Rem "ïåðâûé ìåòîä"
 
Rem "îáíóëåíèå ìàêñèìóìà è ìàññèâà êîîðäèíàò òî÷åê"
 
timeMax = 0
 
For i = LBound(mpnt1) To UBound(mpnt1)
 
 mpnt1(i).x = StartVal + shag * i: mpnt1(i).y = 0
 
Next i
 
Rem "ìàññèâ òî÷åê äëÿ ïåðâîãî ìåòîäà - 1"
 
j = LBound(mpnt1) - 1
 
Progress = ""
 
For i = StartVal To EndVal Step shag
 
 Rem "èíèöèàëèçàöèÿ áîëüøîãî ìàññèâà"
 
 For k = LBound(m5000) To UBound(m5000)
 
 m5000(k) = Int((1000 * Rnd) + 1)
 
 Next k
 
 vs = 0
 
 tm = timeGetTime
 
 InsertionSort m5000, i
 
 vs = (timeGetTime - tm) / 1000
 
 j = j + 1
 
 mpnt1(j).y = Abs(vs)
 
 Progress = i
 
 If timeMax < vs Then timeMax = vs
 
 DoEvents
 
 If indcancel Then
 
 indcancel = False
 
 Progress = ""
 
 Exit Sub
 
 End If
 
Next i
 
J_Max = j
 
SaveResExper 1, J_Max, ResultFile, True '"ñîõðàíåíèå â ôàéëå"
 
Rem "âòîðîé ìåòîä - 2"
 
Rem "îáíóëåíèå ìàêñèìóìîâ è ìàññèâîâ êîîðäèíàò òî÷åê"
 
For i = LBound(mpnt2) To UBound(mpnt2)
 
 mpnt2(i).x = StartVal + shag * i: mpnt2(i).y = 0
 
Next i
 
j = LBound(mpnt2) - 1
 
Progress = ""
 
For i = StartVal To EndVal Step shag
 
 Rem "èíèöèàëèçàöèÿ áîëüøîãî ìàññèâà"
 
 For k = LBound(m5000) To UBound(m5000)
 
 m5000(k) = Int((1000 * Rnd) + 1)
 
 Next k
 
 vs = 0
 
 tm = timeGetTime
 
 BinaryInsertionSort m5000, i
 
 vs = (timeGetTime - tm) / 1000
 
 j = j + 1
 
 mpnt2(j).y = Abs(vs)
 
 Progress = i
 
 If timeMax < vs Then timeMax = vs
 
 DoEvents
 
 If indcancel Then
 
 indcancel = False
 
 Progress = ""
 
 Exit Sub
 
 End If
 
Next i
 
J_Max = j
 
SaveResExper 2, J_Max, ResultFile, False '"ñîõðàíåíèå â ôàéëå"
 
Call ShowGrafik(timeMax, 10, 12)
 
Handler:
 
If Err.Number <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Private Sub ShowGrafik(maxt As Double, cvet1 As Integer, cvet2 As Integer)
 
Dim i As Double, j As Long
 
Dim t As Double '"øàã ïîñòðîåíèÿ"
 
Dim ta As Double '"òåêóùèé àðãóìåíò"
 
Dim x0 As Double, y0 As Double, x1 As Double, y1 As Double
 
Dim xcnt As Double, ycnt As Double, vpole As Double, gpole As Double
 
Dim shag_x As Double, shag_y As Double, Tmp As Double
 
Dim dzsy As Double, dzsx As Double
 
Dim ymax As Double
 
On Error GoTo HandlerError
 
Picture1.Cls
 
ymax = maxt
 
Rem "óñòàíàâëèâàåì ìàñøòàá ïî îñè X"
 
Picture1.ScaleWidth = MaxEndVal * 1.2
 
gpole = MaxEndVal * 0.1
 
shag_x = 500
 
If ymax < 0.1 Then
 
 Picture1.ScaleHeight = 0.12: vpole = 0.01
 
 shag_y = 0.02
 
ElseIf ymax >= 0.1 And ymax < 0.25 Then
 
 Picture1.ScaleHeight = 0.3: vpole = 0.025
 
 shag_y = 0.05
 
ElseIf ymax >= 0.25 And ymax < 0.5 Then
 
 Picture1.ScaleHeight = 0.6: vpole = 0.05
 
 shag_y = 0.1
 
ElseIf ymax >= 0.5 And ymax < 1 Then
 
 Picture1.ScaleHeight = 1.2: vpole = 0.1
 
 shag_y = 0.2
 
ElseIf ymax > 1 And ymax <= 5 Then
 
 Picture1.ScaleHeight = 6: vpole = 0.5
 
 shag_y = 1
 
ElseIf ymax > 5 And ymax <= 10 Then
 
 Picture1.ScaleHeight = 12: vpole = 1
 
 shag_y = 2
 
ElseIf ymax > 10 And ymax <= 30 Then
 
 Picture1.ScaleHeight = 36: vpole = 3
 
 shag_y = 5
 
ElseIf ymax > 30 Then
 
 Picture1.ScaleHeight = 120: vpole = 10
 
 shag_y = 10
 
End If
 
dzsy = Picture1.ScaleHeight * 0.01
 
dzsx = Picture1.ScaleWidth * 0.01
 
xcnt = gpole: ycnt = Picture1.ScaleHeight - vpole
 
Rem "ðèñóåì êîîðäèíàòíûå ëèíèè"
 
Picture1.Line (0, ycnt)-(Picture1.ScaleWidth, ycnt)
 
Picture1.Line (xcnt, 0)-(xcnt, Picture1.ScaleHeight)
 
Rem "ðèñóåì çàñå÷êè"
 
For i = shag_x + gpole To Picture1.ScaleWidth - gpole Step shag_x
 
 Picture1.Line (i, ycnt)-(i, ycnt - dzsy)
 
 Picture1.CurrentX = i - dzsx: Picture1.CurrentY = ycnt + dzsy
 
 Picture1.Print (i - gpole) / 1000
 
Next i
 
Picture1.CurrentX = Picture1.ScaleWidth * 0.96
 
Picture1.CurrentY = ycnt - Picture1.ScaleHeight * 0.03
 
Picture1.Print "N"
 
Picture1.CurrentX = Picture1.ScaleWidth * 0.96
 
Picture1.CurrentY = ycnt + Picture1.ScaleHeight * 0.01
 
Picture1.Print "E3"
 
j = 0
 
For i = Picture1.ScaleHeight - vpole - shag_y To vpole Step -shag_y
 
 Picture1.Line (xcnt, i)-(xcnt + dzsx, i)
 
 j = j + 1
 
 Picture1.CurrentX = xcnt + dzsx
 
 Picture1.CurrentY = i - 0.01 * Picture1.ScaleHeight
 
 Picture1.Print j * shag_y
 
Next i
 
Picture1.CurrentX = xcnt + dzsx
 
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
 
Picture1.Print "t, ñåê"
 
Rem "ðèñîâàíèå ãðàôèêà 1 ìåòîäà"
 
Picture1.ForeColor = QBColor(cvet1)
 
j = LBound(mpnt1)
 
t = shag
 
x0 = xcnt + mpnt1(j).x
 
y0 = ycnt - mpnt1(j).y
 
Do While j < J_Max
 
 j = j + 1
 
 x1 = xcnt + mpnt1(j).x
 
 y1 = ycnt - mpnt1(j).y
 
 If j > J_Max Then Exit Do '"÷òîáû ëèøíåãî íå ñòðîèòü"
 
 Picture1.Line (x0, y0)-(x1, y1)
 
 x0 = x1: y0 = y1
 
Loop
 
Rem "ðèñîâàíèå ãðàôèêà 2 ìåòîäà"
 
Picture1.ForeColor = QBColor(cvet2)
 
j = 0
 
t = shag
 
x0 = xcnt + mpnt2(j).x
 
y0 = ycnt - mpnt2(j).y
 
Do While j < J_Max
 
 j = j + 1
 
 x1 = xcnt + mpnt2(j).x
 
 y1 = ycnt - mpnt2(j).y
 
 If j > J_Max Then Exit Do '"÷òîáû ëèøíåãî íå ñòðîèòü"
 
 Picture1.Line (x0, y0)-(x1, y1)
 
 x0 = x1: y0 = y1
 
Loop
 
Picture1.ForeColor = QBColor(0)
 
Picture1.CurrentX = Picture1.ScaleWidth * 0.3
 
Picture1.CurrentY = 0.01 * Picture1.ScaleHeight
 
Picture1.Print "Çåëåíûé öâåò - ìåòîä ïðîñòûõ âñòàâîê"
 
Picture1.CurrentX = Picture1.ScaleWidth * 0.3
 
Picture1.Print "Êðàñíûé öâåò - ìåòîä áèíàðíûõ âñòàâîê"
 
HandlerError:
 
If Err <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Private Sub SaveResExper(nmas As Integer, nn As Integer, _
 
fname As String, crtnew As Boolean)
 
Dim s As String, s2 As String, i As Long
 
On Error GoTo HandlerError
 
Select Case crtnew
 
 Case True
 
 Open App.Path & "\" & fname For Output As #1
 
 Case False
 
 Open App.Path & "\" & fname For Append As #1
 
End Select
 
Print #1, ""
 
Select Case nmas
 
 Case 1
 
 s = NameMtd1: Print #1, s
 
 Case 2
 
 s = NameMtd2: Print #1, s
 
End Select
 
s = "×èñëî N" & vbTab & "Âðåìÿ, ñåê"
 
Print #1, s
 
Select Case nmas
 
 Case 1
 
 For i = LBound(mpnt1) To nn
 
 s = mpnt1(i).x & vbTab & mpnt1(i).y
 
 Print #1, s
 
 Next i
 
 Case 2
 
 For i = LBound(mpnt1) To nn
 
 s = mpnt2(i).x & vbTab & mpnt2(i).y
 
 Print #1, s
 
 Next i
 
End Select
 
Close #1
 
HandlerError:
 
If Err <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Ìîäóëü1
 
Option Base 1
 
Public fMainForm As frmMain
 
Public m10(1 To 10) As Long, J_Max As Integer
 
Sub Main()
 
 Set fMainForm = New frmMain
 
 fMainForm.Show
 
End Sub
 
Public Sub BinaryInsertionSort(arr() As Long, ByVal n As Long)
 
Dim B As Long
 
Dim C As Long
 
Dim E As Long
 
Dim i As Long
 
Dim j As Long
 
Dim k As Long
 
Dim R As Long
 
On Error GoTo HandlerError
 
i = 2
 
Do
 
 B = 1
 
 E = i - 1
 
 C = (B + E) \ 2
 
 Do While B <> C
 
 If arr(C) > arr(i) Then
 
 E = C
 
 Else
 
 B = C
 
 End If
 
 C = (B + E) \ 2
 
 Loop
 
 If arr(B) < arr(i) Then
 
 If arr(i) > arr(E) Then
 
 B = E + 1
 
 Else
 
 B = E
 
 End If
 
 End If
 
 k = i
 
 R = arr(i)
 
 Do While k > B
 
 arr(k) = arr(k - 1)
 
 k = k - 1
 
 Loop
 
 arr(B) = R
 
 i = i + 1
 
Loop Until Not i <= n
 
HandlerError:
 
If Err <> 0 Then
 
 Err.Clear
 
End If
 
End Sub
 
Public Sub InsertionSort(mas() As Long, ByVal n As Long)
 
Dim i As Long
 
Dim j As Long
 
Dim k As Long
 
Dim R As Long
 
On Error GoTo HandlerError
 
i = 2
 
Do
 
 j = 1
 
 Do
 
 If mas(i) < mas(j) Then
 
 k = i
 
 R = mas(i)
 
 Do
 
 mas(k) = mas(k - 1)
 
 k = k - 1
 
 Loop Until Not k > j
 
 mas(j) = R
 
 j = i
 
 Else
 
 j = j + 1
 
 End If
 
 Loop Until Not j < i
 
 i = i + 1
 
Loop Until Not i <= n
 
HandlerError:
 
If Err <> 0 Then
 
 Err.Clear
 
End If
 
End Sub

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Declare Function timeGetTime Lib "winmm.dll" () As Long