SY-32 Alphabetical Sort Method by Erdogan Tan

FILE: ADRES.BAS [ ADRES 417 Version 2.3 ]

Option Explicit

Type AdresKayiti
     Tip As String * 1
     Kod As String * 20
     Ad As String * 40
     Adres1 As String * 40
     Adres2 As String * 40
     Semt As String * 15
     Kent As String * 15
     Ulke As String * 15
     Posta As String * 5
     Telefon As String * 35
     Fax As String * 19
     Vergi1 As String * 17
     Vergi2 As String * 13
     Meslek As String * 40
     Ozel As String * 40
     Previous As Integer
     Next As Integer
     Parola As String * 7
     GizliBilgi As String * 146
End Type

Type IndexKayiti
     First As Integer
     Last As Integer
End Type

Global Const KEY_UP = &H26
Global Const KEY_DOWN = &H28
Global Const KEY_PRIOR = &H21
Global Const KEY_NEXT = &H22
Global Const KEY_HOME = &H24
Global Const KEY_END = &H23
Global Const KEY_F1 = &H70
Global Const KEY_F2 = &H71
Global Const KEY_F3 = &H72
Global Const KEY_F4 = &H73
Global Const KEY_F5 = &H74
Global Const KEY_F6 = &H75
Global Const KEY_F7 = &H76
Global Const KEY_F8 = &H77
Global Const KEY_F9 = &H78
Global Const KEY_F10 = &H79
Global Const KEY_F11 = &H7A
Global Const KEY_F12 = &H7B
Global Const KEY_ESCAPE = &H1B
Global Adres As AdresKayiti
Global Indeks As IndexKayiti
Global DosyaNo As Integer
Global SonKayit As Integer
Global AktifKayit As Integer
Global IndexDosyaNo As Integer
Global IndexKayitNo As Integer
Global ListeYapildi As Integer
Global LstDosyaNo As Integer
Global Telefon As Integer
Global AbcIlkKayit As Integer
Global AbcSonKayit As Integer
Global HataTipi As Integer
Global PrnTarih As String
Global PrnGun As String
Global Tablo43 As String * 44
Global Tablo112 As String * 112

Public Sub Indekser()
REM SY-32 / TK-44+ [ SY-32 Version 2.TR ] Sort Method by Erdogan Tan
REM 10 June 2001
Dim Start As Integer
Dim KarSay As Integer
Dim TarKarSay As Integer
Dim AktifKod As String
Dim TaramaKod As String
Dim TaramaKayit As Integer
Dim RndPointer As Integer
Dim NextPointer As Integer
Dim Kar(20) As String * 1
Dim AktifKar(20) As Integer
Dim TarKar(20) As Integer
Dim GeriIndex As Integer
Dim IleriIndex As Integer
Dim YeniIndexKayit As Integer
Get #DosyaNo, AktifKayit, Adres
AktifKod = Trim(Adres.Kod)
KarSay = Len(AktifKod)
For Start = 1 To KarSay
    Kar(Start) = Mid$(AktifKod, Start, 1)
    AktifKar(Start) = Sy32Val(Kar(Start))
Next Start
If AktifKar(1) > 0 Then
   IndexKayitNo = AktifKar(1)
   If IndexKayitNo > 44 Then IndexKayitNo = 44
   Get #IndexDosyaNo, IndexKayitNo, Indeks
   If Indeks.Last > 0 Then
      TaramaKayit = Indeks.Last
      Get #DosyaNo, TaramaKayit, Adres
      TaramaKod = Trim(Adres.Kod)
      TarKarSay = Len(TaramaKod)
      For Start = 1 To TarKarSay
          Kar(Start) = Mid$(TaramaKod, Start, 1)
          TarKar(Start) = Sy32Val(Kar(Start))
      Next Start
      If TarKarSay < KarSay Then
         For Start = TarKarSay + 1 To KarSay
             TarKar(Start) = 0
         Next Start
      End If
      If TarKarSay > KarSay Then
         For Start = KarSay + 1 To TarKarSay
             AktifKar(Start) = 0
         Next Start
         KarSay = TarKarSay
      End If
      For Start = 1 To KarSay
          If AktifKar(Start) > TarKar(Start) Then
             Indeks.Last = AktifKayit
             Put #IndexDosyaNo, IndexKayitNo, Indeks
             If Adres.Next = TaramaKayit Then
                Adres.Next = AktifKayit
                Put #DosyaNo, TaramaKayit, Adres
                Get #DosyaNo, AktifKayit, Adres
                Adres.Previous = TaramaKayit
                Adres.Next = AktifKayit
                Put #DosyaNo, AktifKayit, Adres
                Exit Sub
             Else
                RndPointer = Adres.Next
                Adres.Next = AktifKayit
                Put #DosyaNo, TaramaKayit, Adres
                Get #DosyaNo, RndPointer, Adres
                Adres.Previous = AktifKayit
                Put #DosyaNo, RndPointer, Adres
                Get #DosyaNo, AktifKayit, Adres
                Adres.Previous = TaramaKayit
                Adres.Next = RndPointer
                Put #DosyaNo, AktifKayit, Adres
                Exit Sub
             End If
          Else
             If AktifKar(Start) < TarKar(Start) Then Exit For
          End If
      Next Start
   End If
   If Indeks.First > 0 Then
      TaramaKayit = Indeks.First
      Get #DosyaNo, TaramaKayit, Adres
      TaramaKod = Trim(Adres.Kod)
      TarKarSay = Len(TaramaKod)
      NextPointer = Adres.Next
      For Start = 1 To TarKarSay
          Kar(Start) = Mid$(TaramaKod, Start, 1)
          TarKar(Start) = Sy32Val(Kar(Start))
      Next Start
      If TarKarSay < KarSay Then
         For Start = TarKarSay + 1 To KarSay
             TarKar(Start) = 0
         Next Start
      End If
      If TarKarSay > KarSay Then
         For Start = KarSay + 1 To TarKarSay
             AktifKar(Start) = 0
         Next Start
         KarSay = TarKarSay
      End If
      For Start = 1 To KarSay
          If AktifKar(Start) < TarKar(Start) Then
             Indeks.First = AktifKayit
             Put #IndexDosyaNo, IndexKayitNo, Indeks
             If Adres.Previous = TaramaKayit Then
                Adres.Previous = AktifKayit
                Put #DosyaNo, TaramaKayit, Adres
                Get #DosyaNo, AktifKayit, Adres
                Adres.Previous = AktifKayit
                Adres.Next = TaramaKayit
                Put #DosyaNo, AktifKayit, Adres
                Exit Sub
             Else
                RndPointer = Adres.Previous
                Adres.Previous = AktifKayit
                Put #DosyaNo, TaramaKayit, Adres
                Get #DosyaNo, RndPointer, Adres
                Adres.Next = AktifKayit
                Put #DosyaNo, RndPointer, Adres
                Get #DosyaNo, AktifKayit, Adres
                Adres.Previous = RndPointer
                Adres.Next = TaramaKayit
                Put #DosyaNo, AktifKayit, Adres
                Exit Sub
             End If
          Else
             If AktifKar(Start) > TarKar(Start) Then Exit For
          End If
      Next Start
   End If
   If Indeks.First < 1 Or Indeks.Last < 1 Then
      Indeks.First = AktifKayit
      Indeks.Last = AktifKayit
      Put #IndexDosyaNo, IndexKayitNo, Indeks
      If IndexKayitNo > 1 Then
         GeriIndex = IndexKayitNo - 1
      Else
         Get #DosyaNo, AktifKayit, Adres
         Adres.Previous = AktifKayit
         Put #DosyaNo, AktifKayit, Adres
         GoTo Devam
      End If
Geri:
      Get #IndexDosyaNo, GeriIndex, Indeks
      RndPointer = Indeks.Last
      If RndPointer < 1 Then
         If GeriIndex > 1 Then
            GeriIndex = GeriIndex - 1
            GoTo Geri
         Else
            Get #DosyaNo, AktifKayit, Adres
            Adres.Previous = AktifKayit
            Put #DosyaNo, AktifKayit, Adres
            GoTo Devam
         End If
      Else
         Get #DosyaNo, AktifKayit, Adres
         Adres.Previous = RndPointer
         Put #DosyaNo, AktifKayit, Adres
         Get #DosyaNo, RndPointer, Adres
         Adres.Next = AktifKayit
         Put #DosyaNo, RndPointer, Adres
      End If
Devam:
      If IndexKayitNo < 44 Then
         IleriIndex = IndexKayitNo + 1
      Else
         Get #DosyaNo, AktifKayit, Adres
         Adres.Next = AktifKayit
         Put #DosyaNo, AktifKayit, Adres
         Exit Sub
      End If
Ileri:
      Get #IndexDosyaNo, IleriIndex, Indeks
      RndPointer = Indeks.First
      If RndPointer < 1 Then
         If IleriIndex < 44 Then
            IleriIndex = IleriIndex + 1
            GoTo Ileri
         Else
            Get #DosyaNo, AktifKayit, Adres
            Adres.Next = AktifKayit
            Put #DosyaNo, AktifKayit, Adres
            Exit Sub
         End If
      Else
         Get #DosyaNo, AktifKayit, Adres
         Adres.Next = RndPointer
         Put #DosyaNo, AktifKayit, Adres
         Get #DosyaNo, RndPointer, Adres
         Adres.Previous = AktifKayit
         Put #DosyaNo, RndPointer, Adres
      End If
      Exit Sub
   End If
Yeniden:
   IleriIndex = IndexKayitNo
   If NextPointer = TaramaKayit Then
Sonraki:
      If IleriIndex < 44 Then
         IleriIndex = IleriIndex + 1
         Get #IndexDosyaNo, IleriIndex, Indeks
         RndPointer = Indeks.First
         If RndPointer < 1 Then
            GoTo Sonraki
         Else
            Adres.Next = RndPointer
            Put #DosyaNo, TaramaKayit, Adres
            Get #DosyaNo, RndPointer, Adres
            Adres.Previous = TaramaKayit
            Put #DosyaNo, RndPointer, Adres
            NextPointer = RndPointer
         End If
      Else
         MsgBox ("Sıralama hatalı!  Düzeltmek için 'Oluştur' yada 'Sil' komutunu çalıştırın..."), 48, "! SIRALAMA  HATASI !"
         Exit Sub
      End If
   End If
   TaramaKayit = NextPointer
   Get #DosyaNo, TaramaKayit, Adres
   TaramaKod = Trim(Adres.Kod)
   TarKarSay = Len(TaramaKod)
   NextPointer = Adres.Next
   For Start = 1 To TarKarSay
       Kar(Start) = Mid$(TaramaKod, Start, 1)
       TarKar(Start) = Sy32Val(Kar(Start))
   Next Start
   If TarKarSay < KarSay Then
      For Start = TarKarSay + 1 To KarSay
          TarKar(Start) = 0
      Next Start
   End If
   If TarKarSay > KarSay Then
      For Start = KarSay + 1 To TarKarSay
          AktifKar(Start) = 0
      Next Start
      KarSay = TarKarSay
   End If
   For Start = 1 To KarSay
       If AktifKar(Start) < TarKar(Start) Then
          RndPointer = Adres.Previous
          Adres.Previous = AktifKayit
          Put #DosyaNo, TaramaKayit, Adres
          Get #DosyaNo, RndPointer, Adres
          Adres.Next = AktifKayit
          Put #DosyaNo, RndPointer, Adres
          Get #DosyaNo, AktifKayit, Adres
          Adres.Previous = RndPointer
          Adres.Next = TaramaKayit
          Put #DosyaNo, AktifKayit, Adres
          Exit Sub
       Else
          If AktifKar(Start) > TarKar(Start) Then Exit For
       End If
   Next Start
   GoTo Yeniden
End If
End Sub

Public Function Sy32Val(Character As String) As Integer
If Character = "ç" Then
   Character = "Ç"
Else
   If Character = "ğ" Then
      Character = "Ğ"
   Else
      If Character = "ı" Then
         Character = "I"
      Else
         If Character = "i" Then
            Character = "İ"
         Else
            If Character = "ö" Then
               Character = "Ö"
            Else
               If Character = "ş" Then
                  Character = "Ş"
               Else
                  If Character = "ü" Then
                     Character = "Ü"
                  Else
                     Character = UCase(Character)
                  End If
               End If
            End If
         End If
      End If
   End If
End If
Sy32Val = InStr(Tablo43, Character)
If Sy32Val = 0 Then Sy32Val = 44 + Asc(Character)
End Function

FILE: ADRES.FRM [ ADRES 417 Version 2.3 ]

Tablo43 = Chr$(32) + "0123456789ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ" + Chr$(0)

***

NOTE: SY-26 and SY-32 have same logic but SY-26 uses direct ASC codes while 
SY-32 uses (Turkish based) modified character-index values. Sy32Val function 
gives the modified value for Index file which has 44 sort records. Previous 
version of SY-32 was using "instr" function and a character sort table which 
has 109 characters.

Read sy-26.html for other SY-26/SY-32 snippets and US-English sort method.

Return to adres417.html