Changeset 611 for trunk

Timestamp:

2008/08/22 23:41:40 (4 years ago)

Author:

egtra

Message:

ListBox?.Itemsを実装。サンプルも修正。

Location:

trunk/ab5.0/ablib

Files:

• TestCase/UI_Sample/mouse_watcher.ab (modified) (2 diffs)
• TestCase/UI_Sample/mouse_watcher_dlg.ab (modified) (2 diffs)
• src/Classes/ActiveBasic/Windows/UI/ListBox.ab (modified) (2 diffs)

trunk/ab5.0/ablib/TestCase/UI_Sample/mouse_watcher.ab

@@ -49 +49 @@
     Sub OnClearClick(sender As Object, e As Args)
         LockWindowUpdate(list)
-        While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
-        Wend
+        list.Items.Clear()
         LockWindowUpdate(0)
     End Sub
@@ -91 +90 @@
 
     Sub OnMouseEvent(kind As String, e As MouseArgs)
+        Dim items = list.Items
         Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
-        Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
-        If lr <> LB_ERR And lr <> LB_ERRSPACE Then
-            list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
-        End If
+        items.Add(s)
+        list.SetSelected(items.Count - 1, True)
     End Sub
 

trunk/ab5.0/ablib/TestCase/UI_Sample/mouse_watcher_dlg.ab

@@ -68 +68 @@
     Sub OnClearClick(sender As Object, e As Args)
         LockWindowUpdate(list)
-        While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
-        Wend
+        list.Items.Clear()
         LockWindowUpdate(0)
     End Sub
@@ -116 +115 @@
 
     Sub OnMouseEvent(kind As String, e As MouseArgs)
+        Dim items = list.Items
         Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
-        Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
-        If lr <> LB_ERR And lr <> LB_ERRSPACE Then
-            list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
-        End If
+        items.Add(s)
+        list.SetSelected(items.Count - 1, True)
     End Sub
 

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

@@ -8 +8 @@
 /*!
 @brief リストボックスコントロールのクラス
-@date 2007/07/21
+@date 2008/07/21
 @auther Egtra
 */
 Class ListBox
     Inherits Control
+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
 Protected
     Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
@@ -20 +37 @@
     End Sub
 
-    'ToDo: Lineなどを設ける
+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