文字列(テキスト)の並び替え <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