'Classes/ActiveBasic/Windows/UI/ListBox.ab
#require <Classes/ActiveBasic/Windows/UI/Control.ab>

Namespace ActiveBasic
Namespace Windows
Namespace UI

/*!
@brief リストボックスコントロールのクラス
@date 2008/07/21
@auther Egtra
*/
Class ListBox
	Inherits WmCommandControl
Public
	Sub ListBox()
		items = New Detail.ListBoxItemList(This)
	End Sub

	Function Items() As System.Collections.Generic.IList<String>
		Items = items
	End Function

	Sub SetSelected(i As Long, select As Boolean)
		Dim now = SendMessage(LB_GETSEL, i As WPARAM, 0)
		lrCheck(now, i, "ListBox.SetSelected")
		If (now > 0) <> (select As Long <> 0) Then
			'現状とselectが異なればLB_SETCURSELで反転させる。
			lrCheck(SendMessage(LB_SETCURSEL, i As WPARAM, 0), i, "ListBox.SetSelected")
		End If
	End Sub

	/*
	@date 2008/10/18
	@todo 対応するイベントをまだ設けていない通知メッセージへの対応
	*/
	Override Function RaiseCommandEvent(notificationCode As Word) As Boolean
		Dim lr As LRESULT
		RaiseCommandEvent = False
		Select Case notificationCode
			Case LBN_ERRSPACE
				RaiseCommandEvent = False
			Case LBN_SELCHANGE
				RaiseCommandEvent = False
			Case BN_CLICKED
				RaiseCommandEvent = OnClick(Args.Empty)
			Case LBN_DBLCLK
				RaiseCommandEvent = OnDoubleClick(Args.Empty)
			Case LBN_SELCANCEL
				RaiseCommandEvent = False
			Case LBN_SETFOCUS
				RaiseCommandEvent = ProcessMessage(WM_SETFOCUS, 0, 0, lr)
			Case LBN_KILLFOCUS
				RaiseCommandEvent = ProcessMessage(WM_KILLFOCUS, 0, 0, lr)
		End Select
	End Function
Protected
	Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
		With cs
			.lpszClass = "LISTBOX"
		End With
	End Sub

Private
	items As Detail.ListBoxItemList

	Sub lrCheck(lr As LRESULT, i As Long, s As String)
		Detail.LRCheck(lr, i, items.Count, s)
	End Sub

	Sub lrCheck(lr As LRESULT, s As String)
		Detail.LRCheck(lr, s)
	End Sub
End Class

Namespace Detail

Class ListBoxItemList
	Implements System.Collections.Generic.IList<String>
Public
	Sub ListBoxItemList(l As ListBox)
		base = l
	End Sub

	Function GetEnumerator() As System.Collections.Generic.IEnumerator<String>
	End Function

	Function Count() As Long
		Count = base.SendMessage(LB_GETCOUNT) As Long
		lrCheck(Count, "ListBox.Item.Count")
	End Function

	Function IsReadOnly() As Boolean
		Return False
	End Function

	Sub Add(s As String)
		lrCheck(base.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM), "ListBox.Item.Add")
	End Sub

	Sub Clear()
		Do : Loop Until removeAtImpl(0) = LB_ERR
	End Sub

	Function Remove(s As String) As Boolean
		Dim i = IndexOf(s)
		If i = -1 Then
			Remove = False
		Else
			removeAtImpl(i)
			Remove = True
		End If
	End Function

	Sub Operator [](index As Long, item As String)
		Item[index] = item
	End Sub

	Function Operator [](index As Long) As String
		Return Item[index]
	End Function

	Virtual Sub Item(i As Long, s As String)
		lrCheck(removeAtImpl(i), i, "ListBox.Item[] (set)")
		lrCheck(base.SendMessage(LB_INSERTSTRING, 0, ToTCStr(s) As LPARAM), i, "ListBox.Item[] (set)")
	End Sub

	Virtual Function Item(i As Long) As String
		Dim len = base.SendMessage(LB_GETTEXTLEN, i As WPARAM, 0)
		lrCheck(len, i, "ListBox.Item[] (get)")
		Dim sb = New System.Text.StringBuilder(len)
		sb.Length = len
		len = base.SendMessage(LB_GETTEXT, i As WPARAM, StrPtr(sb) As LPARAM)
		lrCheck(len, i, "ListBox.Item[] (get)")
		sb.Length = len
		Item = sb.ToString
	End Function

	Virtual Function IndexOf(s As String) As Long
		'見つからなかったときに返るLB_ERRはちょうど-1。
		IndexOf = base.SendMessage(LB_FINDSTRINGEXACT, -1 As WPARAM, ToTCStr(s) As LPARAM) As Long
	End Function

	Virtual Sub Insert(i As Long, s As String)
		Dim lr = base.SendMessage(LB_INSERTSTRING, 0, ToTCStr(s) As LPARAM)
		lrCheck(lr, i, "ListBox.Item.Insert")
	End Sub

	Virtual Sub RemoveAt(i As Long)
		Dim lr = removeAtImpl(i)
		lrCheck(lr, i, "ListBox.Item.RemoveAt")
	End Sub
Private
	Function removeAtImpl(i As Long) As LRESULT
		removeAtImpl = base.SendMessage(LB_DELETESTRING, i As WPARAM, 0)
	End Function

	Sub lrCheck(lr As LRESULT, s As String)
		LRCheck(lr, s)
	End Sub

	Sub lrCheck(lr As LRESULT, i As Long, s As String)
		LRCheck(lr, i, Count, s)
	End Sub

	base As ListBox
End Class

/*!
@brief List Boxからの戻り値がエラー値の場合に例外を投げる。
@param[in] lr SendMessageなどの戻り値
@param[in] s 例外を投げるときに添加するメッセージ
@throw SystemException lrがエラー値のとき
@date 2008/08/21
@auther Egtra
*/
Sub LRCheck(lr As LRESULT, s As String)
	If lr = LB_ERR Then
		Throw New System.SystemException(s & " (LB_ERR)")
	ElseIf lr = LB_ERRSPACE Then
		Throw New System.SystemException(s & " (LB_ERRSPACE)")
	End If
End Sub

/*!
@brief List Boxからの戻り値がエラー値の場合に例外を投げる。
@param[in] lr SendMessageなどの戻り値
@param[in] i インデックス
@param[in] max インデックスの許容される最大値
@param[in] s 例外を投げるときに添加するメッセージ
@throw SystemException lrがエラー値のとき
@throw OutOfRangeException lrがLB_ERRで、なおかつiが範囲外のとき
@date 2008/08/21
@auther Egtra
こちらは、iが範囲外かならOutOfRangeExceptionを投げるのが特徴
*/
Sub LRCheck(lr As LRESULT, i As Long, max As Long, s As String)
	If lr = LB_ERR Then
		If i < 0 Or i >= max Then
			Throw New System.ArgumentOutOfRangeException(s)
		Else
			Throw New System.SystemException(s & " (LB_ERR)")
		End If
	ElseIf lr = LB_ERRSPACE Then
		Throw New System.SystemException(s & " (LB_ERRSPACE)")
	End If
End Sub

End Namespace

End Namespace 'UI
End Namespace 'Widnows
End Namespace 'ActiveBasic