ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月29日(金) 01:45

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 5 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2006年10月19日(木) 20:33 
件名どおり、リストビューで、カラム(列・縦のライン)ごとのソート(並び替え)をする方法を書きます。
以下の過去ログを参考にしました。
http://www.activebasic.com/forum/viewtopic.php?t=576
三日ぐらい悩んで完成させたのですが、基本的な事なのになぜか過去ログに載ってない様なので、私の苦労が皆様のお役に立てばと思い、投稿します。

詳しい解説は、私が書くより以下のページへ。言語は違うけど、やってる事は同じなので分かると思います。
http://www.kumei.ne.jp/c_lang/sdk2/sdk_110.htm

■私の環境
OS WinXP Home SP
AB 4.13

■準備
RADでリストビューを貼り付ける。
プロパティで、表示をレポートにする。
リストビューのイベントコードでカラムの1つがクリックされたときを選択。

■コード
コード:
Dim hLV As HWND			'リストビューハンドル
Dim SortLV =1 As Long		'昇/降順判定
hLV = GetDlgItem(hMainWnd,ListView1)

Sub MainWnd_ListView1_ColumnClick(ByRef nmListView As NMLISTVIEW)	'リストソート カラムクリック
	If SortLV > 0 Then
		SortLV = -1
	Else
		SortLV = 1
	End If
	SendMessage(hLV, LVM_SORTITEMS, nmListView.iSubItem, AddressOf(CompareProc) As LPARAM)
End Sub

Function CompareProc(lp1 As Long, lp2 As Long, lpSort As Long) As Long
	Dim nItem1 As Long				'比較のためのコールバック関数
	Dim nItem2 As Long
	Dim bBuf1[MAX_PATH] As Byte
	Dim bBuf2[MAX_PATH] As Byte
	Dim lvf As LVFINDINFO

	lvf.flags = LVFI_PARAM
	lvf.lParam = lp1
	nItem1 = SendMessage(hLV, LVM_FINDITEM, -1, VarPtr(lvf) As LPARAM)

	lvf.lParam = lp2
	nItem2 = SendMessage(hLV, LVM_FINDITEM, -1, VarPtr(lvf) As LPARAM)

	GetLVText(nItem1, lpSort, bBuf1)
	GetLVText(nItem2, lpSort, bBuf2)

	If lpSort = 0 or lpSort = 3 Then		'カラム(列)が0.3の時は数値で比較
		nItem1 = Val(bBuf1) As Long
		nItem2 = Val(bBuf2) As Long
		If nItem1 = nItem2 Then
			CompareProc = 0
		ElseIf nItem1 > nItem2 Then
			CompareProc = 1
		Else
			CompareProc = -1
		End If
	Else
		CompareProc = lstrcmp(bBuf1, bBuf2)
	End If

	If SortLV < 0 Then CompareProc = CompareProc * -1	'降順 -1を掛ける。昇順はそのまま。
End Function

Sub GetLVText(ByRef iItem As Long, ByRef iSubItem As Long, ByRef pszText[MAX_PATH] As Byte)
	Dim lvi As LVITEM
	With lvi
		.mask = LVIF_TEXT
		.iItem = iItem
		.iSubItem = iSubItem
		.cchTextMax = MAX_PATH
		.pszText = pszText
	End With
	SendMessage(hLV, LVM_GETITEM, 0, VarPtr(lvi) As LPARAM)
End Sub

Sub SetLVText(ByRef iItem As Long, ByRef iSubItem As Long, ByRef pszText As String)
	Dim lvi As LVITEM
	With lvi
		.iItem = iItem
		.iSubItem = iSubItem
		.cchTextMax = MAX_PATH
		.pszText = StrPtr(pszText)
		If .iSubItem = 0 Then
			.mask = LVIF_TEXT or LVIF_PARAM
			.lParam = iItem
			SendMessage(hLV,LVM_INSERTITEM,0,VarPtr(lvi) As LPARAM)		'0 = インサート
		Else
			.mask = LVIF_TEXT
			SendMessage(hLV,LVM_SETITEM,0,VarPtr(lvi) As LPARAM)		'0 <> セット
		End If
	End With
End Sub
■補足
まずリストビューにアイテムを入れるのにはSetLVTextを使います。
サブアイテムが0の時にインサートし、その時にLVIF_PARAMを追加します。(これをやらないとソートできない)
ここでは、行(横のライン)の値をそのまま使ってます。

カラムクリックでNMLISTVIEW構造体にどのカラムがクリックされたか入るのでそれを利用します。
昇順/降順はクリックするたびに替わります。

CompareProcの最後の所は
コード:
CompareProc = lstrcmp(bBuf1, bBuf2) 
If SortLV < 0 Then CompareProc = CompareProc * -1
で、良いのですが、例えば1~100までの数値をソートした場合、1、10、100、11、12…19、2、20と変な並びになってしまいます。
そこでlpSortにはクリックされたカラムが入ってますので、ここでは1番目と4番目の時は数値にして比較してます。
しかし、文字と数が混ざっている場合は不可能です。ここら辺良いやり方を知っていたら教えて欲しいです。

注意点は、扱える文字列の長さがMAX_PATHですので変えたい場合は、関数を弄ったりして下さい。
setLVText、getLVTextとも引数がByRefになってるので気をつけてください。

リストビューから文字列を得るのにはGetLVTextを使いますが
過去ログの所ではLVM_GETITEMTEXTで文字列をリストビューから取得していて、
それだと設定したlParamの値が取得できないらしく、これに気づくまでに相当無意味な時間を過ごしました。

文字列がByte配列だったり、String型だったりしてますが、それは大目に見てください。
(ここら辺が未だに4.13を使ってる理由になってると思います・汗)

こうした方が速いとか、簡単だとか、上記の数値が順番どおりに並ぶ方法とかあったら教えて下さい。


通報する
ページトップ
   
投稿記事Posted: 2006年10月19日(木) 20:42 
書き忘れと間違い。

環境はSP2ですね。

私の環境(celeron CPU 1.7GHz、224MB RAM)では、6列800行ぐらいのソートに約1秒ぐらいかかります。
大体こんな物なのかな。


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2006年10月19日(木) 22:39 
>しかし、文字と数が混ざっている場合は不可能です。ここら辺良いやり方を知っていたら教えて欲しいです。
>こうした方が速いとか、簡単だとか、上記の数値が順番どおりに並ぶ方法とかあったら教えて下さい。
これがこの投稿での本当の目的か。


通報する
ページトップ
   
 記事の件名:
投稿記事Posted: 2006年10月20日(金) 19:30 
オフライン

登録日時: 2005年7月25日(月) 13:27
記事: 893
お住まい: 埼玉県東松山市
数字列か文字列か判断して、ソートさせればどうだろう?

_________________
Website→http://web1.nazca.co.jp/himajinn13sei/top.html
ここ以外の場所では「暇人13世」というHNを主として使用。

に署名を書き換えて欲しいと言われたので暇だしやってみるテスト。


通報する
ページトップ
投稿記事Posted: 2006年10月21日(土) 19:29 
>konishiさん
返信有難う御座います。
文字だけ、数字だけで出来てる文字列ならそれで良いのですが、
例えば、以下のファイル名の様に、数字と文字が混じった物の場合を考えていたのです。

image1.bmp
image43.jpg
画像4.gif
画像569.png
10music.mp3
2music.wav

そこで、何とか自力で作ってみました。こういうのを自然順ソートと言うらしいです。
意外とスピードは落ちませんでした。以前と同じ条件でも若干遅くなる(1秒強)程度です。
仕組みは文字列から数字の部分を抜き出してそれを比較してるだけです。
数字の位置、数字以前にある文字列も比較してます。
数字の先頭に0が幾つあってもすれを無視して並び替えます。
例えば0005は5として考えます。つまり以下のような並びになります。

00005
6
07
0000000000010

途中に数字以外の文字があっても並び替えられます。
しかし、数字部分が二箇所以上あると並び替えられません。
つまり、以下のような並びになってしまいます。

image1abc1
image1abc10
image1abc2
image2abc5
image10abc1

しかし、やろうと思えば数値の場所を検索するのを繰り返せば良いだけなので
そんなに難しくは無いと思います。その分遅くなるでしょうけど。

以下、サンプルコードです。
まず、最初の投稿の以下の部分を変更して下さい。
コード:
If lpSort = 0 or lpSort = 3 Then        'カラム(列)が0.3の時は数値で比較 
    nItem1 = Val(bBuf1) As Long 
    nItem2 = Val(bBuf2) As Long 
    If nItem1 = nItem2 Then 
        CompareProc = 0 
    ElseIf nItem1 > nItem2 Then 
        CompareProc = 1 
    Else 
        CompareProc = -1 
    End If 
Else 
    CompareProc = lstrcmp(bBuf1, bBuf2) 
End If 

If SortLV < 0 Then CompareProc = CompareProc * -1    '降順 -1を掛ける。昇順はそのまま。 

↑を↓に変えてください。

CompareProc = NaturalSort(bBuf1, bBuf2)
If CompareProc = -2 Then CompareProc = lstrcmp(bBuf1, bBuf2)
以下の関数を付記して下さい。
コード:
Function NaturalSort(ByRef bBuf1[MAX_PATH] As Byte,ByRef bBuf2[MAX_PATH] As Byte) As Long

	Dim i As Integer, t As Integer
	Dim str1 As String, str2 As String
	Dim Num1 As Long, Num2 As Long

	NaturalSort = -2					'返り値入れとく

	Num1= lstrlen(bBuf1)-1
	For i=0 To Num1						'数の位置ゲット 1
		Select Case bBuf1
			Case 48,49,50,51,52,53,54,55,56,57 : Exit For
		End Select
		If i=Num1 Then Exit Function	'見つからない
	Next

	Num2= lstrlen(bBuf2)-1
	For t=0 To Num2						'数の位置ゲット 2
		Select Case bBuf2[t]
			Case 48,49,50,51,52,53,54,55,56,57 : Exit For
		End Select	
		If t=Num2 Then Exit Function
	Next

	If i<>t Then Exit Function			'数の位置 違う
	
	str1= Mid$(bBuf1, i+1)				'数値以降 文字 ゲット
	str2= Mid$(bBuf2, t+1)
	Num1= Val(str1) As Long				'数値化
	Num2= Val(str2) As Long

	If Num1 = Num2 Then Exit Function	'数値同じ

	If i>1 Then
		str1= Left$(bBuf1,i)			'数値が途中にある 数値以前の文字 ゲット
		str2= Left$(bBuf2,t)
		If str1<>str2 Then Exit Function	'違う
	End If

	If Num1 = Num2 Then
		NaturalSort = 0
	ElseIf Num1 > Num2 Then
		NaturalSort = 1
	Else
		NaturalSort = -1
	End If

End Function

ゲストさん
本当の目的も嘘の目的も無いですよ。
勿論、あなたの様に無記名で他人にケチをつけるような目的もありません。
言葉に気をつけたほうが良いと思います。


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 5 件の記事 ] 

全ての表示時間は UTC+09:00 です


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[12人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean