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