文字列(テキスト)の並び替え          <TOP>


文字列(テキスト)の並び替え

GetThreadLocale スレッドのロケールIDを取得

CompareString 比較オプションに対応した文字列比較関数

 

例では、当HPの索引(発音順:個人的な^^;)を読み込み昇順または降順に並び替えを行っています。

VisualBasicでのStrCpmpの代わりにAPIのCompareStringを使っています。

参照

ソートのテスト

 

'================================================================
'= 文字列(テキスト)の並び替え
'=    (Sort.bas)
'================================================================
#include "Windows.bi"

' スレッドのロケールIDを取得
Declare Function Api_GetThreadLocale& Lib "Kernel32" Alias "GetThreadLocale" ()

' 比較オプションに対応した文字列比較関数
Declare Function Api_CompareString& Lib "kernel32" Alias "CompareStringA" (ByVal Locale&, ByVal dwCmpFlags&, ByVal lpString1$, ByVal cchCount1&, ByVal lpString2$, ByVal cchCount2&)

#define NORM_IGNORECASE &H1          '大文字・小文字を区別しない
#define CSTR_LESS_THAN 1             '文字列1 < 文字列2
#define CSTR_EQUAL 2                 '文字列1 = 文字列2
#define CSTR_GREATER_THAN 3          '文字列1 > 文字列2

Var Shared Text(1) As Object
Var Shared Edit(1) As Object
Var Shared Radio(1) As Object
Var Shared List(1) As Object
Var Shared Button1 As Object

For i = 0 To 1
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 14
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1))) : Radio(i).SetFontSize 14
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 14
    List(i).Attach GetDlgItem("List" & Trim$(Str$(i + 1))) : List(i).SetFontSize 12
Next
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub SelectionSort(Dat() As String, ByVal Min As Integer, ByVal Max As Integer)
Sub SelectionSort(Dat() As String, ByVal Min As Integer, ByVal Max As Integer)
    Var hTL As Long
    Var i As Integer
    Var j As Integer
    Var bj As Integer
    Var bs As String
    Var temp As String

    'カレントロケール取得
    hTL = Api_GetThreadLocale()

    For i = Min To Max - 1
        bj = i
        bs = Dat(i)
        For j = i + 1 To Max
            If Api_CompareString(hTL, NORM_IGNORECASE, Dat(j), Len(Dat(j)), bs, Len(bs)) = CSTR_LESS_THAN Then
                bs = Dat(j)
                bj = j
            End If
        Next j
        Dat(bj) = Dat(i)
        Dat(i) = bs
    Next i
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var FilePath As String

    FilePath = "C:\_FB_API_E\"
    If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    Edit(0).SetWindowText FilePath & "Tips.txt"
    Edit(1).SetWindowText FilePath & "sorted.txt"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Lines(500) As String
    Var NewLine As String
    Var MaxLine As Integer
    Var FF As Integer
    Var i As Integer

    List(0).ResetContent
    List(1).ResetContent

    SetMousePointer 2
    CallEvent
    
    'ソート前テキスト読み込み
    FF = FreeFile
    Open Edit(0).GetWindowText For Input As FF
    Do While Not EOF(FF)
        Line Input #FF, NewLine
        NewLine = Trim$(NewLine)

        MaxLine = MaxLine + 1
        Lines(MaxLine) = NewLine
        List(0).AddString NewLine
    Loop
    Close FF

    'ソート実行
    SelectionSort Lines(), 1, MaxLine

    On Error Goto *Er_Trap

    'ソート後テキスト書き込み
    Open Edit(1).GetWindowText For Output As FF
    If Radio(0).GetCheck = 1 Then
        '昇順
        For i = 1 To MaxLine
            Print #FF, Lines(i)
            List(1).AddString Lines(i)
        Next i
    Else
        '降順
        For i = MaxLine To 1 Step -1
            Print #FF, Lines(i)
            List(1).AddString Lines(i)
        Next i
    End If
    Close FF
    
    SetMousePointer 0
'   A% = MessageBox(GetWindowText, "Sorted " & Format$(MaxLine) & " Lines", 0, 2)
    Exit Sub

*Er_Trap
    If Err = 64 Then
        Close #FF
        Kill Edit(1).GetWindowText
        Open Edit(1).GetWindowText For Output As FF
        Resume Next
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End