source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/ListBox.ab

'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