Attribute VB_Name = "mod_ArraySorting"
' Copyright (C) 2002-2008 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues



' ShellSort - Alogarythmus
' You can use this concept for free without mentioning if you complete rewrite it

Option Explicit
Option Base 0

Public Sub ArraySort_String(ByRef xArray() As String, ByVal ElementsToSort As Long, Optional ByVal StartPos As Long = 0&, Optional ByVal IgnoreCase As Boolean = True)
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xChar1 As String
  
  ElementsToSort = ElementsToSort - 1&
  Do
    xLong1 = 3& * xLong1 + 1&
    Loop Until xLong1 > ElementsToSort
  'Stop
  'IgnoreCase = False
  Do
    xLong1 = xLong1 \ 3&
    For xLong2 = xLong1 + StartPos To ElementsToSort + StartPos
      xChar1 = xArray(xLong2)
      If IgnoreCase Then
        For xLong3 = xLong2 - xLong1 To StartPos Step -xLong1
          If StrComp(xArray(xLong3), xChar1, vbTextCompare) < 1 Then Exit For
          xArray(xLong3 + xLong1) = xArray(xLong3)
          Next
        Else
        For xLong3 = xLong2 - xLong1 To StartPos Step -xLong1
          If Not xArray(xLong3) > xChar1 Then Exit For
          xArray(xLong3 + xLong1) = xArray(xLong3)
          Next
        End If
      xArray(xLong3 + xLong1) = xChar1
      Next
    Loop While xLong1
  End Sub

