Changeset 611 for trunk/ab5.0


Ignore:
Timestamp:
Aug 22, 2008, 11:41:40 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

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

Location:
trunk/ab5.0/ablib
Files:
3 edited

Legend:

Unmodified
Added
Removed

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

    r590 r611  
    4949    Sub OnClearClick(sender As Object, e As Args)
    5050        LockWindowUpdate(list)
    51         While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
    52         Wend
     51        list.Items.Clear()
    5352        LockWindowUpdate(0)
    5453    End Sub
    … …  
    9190
    9291    Sub OnMouseEvent(kind As String, e As MouseArgs)
     92        Dim items = list.Items
    9393        Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
    94         Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
    95         If lr <> LB_ERR And lr <> LB_ERRSPACE Then
    96             list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
    97         End If
     94        items.Add(s)
     95        list.SetSelected(items.Count - 1, True)
    9896    End Sub
    9997

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

    r576 r611  
    6868    Sub OnClearClick(sender As Object, e As Args)
    6969        LockWindowUpdate(list)
    70         While list.SendMessage(LB_DELETESTRING, 0, 0) > 0
    71         Wend
     70        list.Items.Clear()
    7271        LockWindowUpdate(0)
    7372    End Sub
    … …  
    116115
    117116    Sub OnMouseEvent(kind As String, e As MouseArgs)
     117        Dim items = list.Items
    118118        Dim s = kind + ": X = " + Str$(e.X) + " Y = " + Str$(e.Y)
    119         Dim lr = list.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM)
    120         If lr <> LB_ERR And lr <> LB_ERRSPACE Then
    121             list.SendMessage(LB_SETCURSEL, lr As WPARAM, 0)
    122         End If
     119        items.Add(s)
     120        list.SetSelected(items.Count - 1, True)
    123121    End Sub
    124122

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

    r576 r611  
    88/*!
    99@brief リストボックスコントロールのクラス
    10 @date 2007/07/21
     10@date 2008/07/21
    1111@auther Egtra
    1212*/
    1313Class ListBox
    1414    Inherits Control
     15Public
     16    Sub ListBox()
     17        items = New Detail.ListBoxItemList(This)
     18    End Sub
     19
     20    Function Items() As System.Collections.Generic.IList<String>
     21        Items = items
     22    End Function
     23
     24    Sub SetSelected(i As Long, select As Boolean)
     25        Dim now = SendMessage(LB_GETSEL, i As WPARAM, 0)
     26        lrCheck(now, i, "ListBox.SetSelected")
     27        If (now > 0) <> (select As Long <> 0) Then
     28            '現状とselectが異なればLB_SETCURSELで反転させる。
     29            lrCheck(SendMessage(LB_SETCURSEL, i As WPARAM, 0), i, "ListBox.SetSelected")
     30        End If
     31    End Sub
    1532Protected
    1633    Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    … …  
    2037    End Sub
    2138
    22     'ToDo: Lineなどを設ける
     39Private
     40    items As Detail.ListBoxItemList
     41
     42    Sub lrCheck(lr As LRESULT, i As Long, s As String)
     43        Detail.LRCheck(lr, i, items.Count, s)
     44    End Sub
     45
     46    Sub lrCheck(lr As LRESULT, s As String)
     47        Detail.LRCheck(lr, s)
     48    End Sub
    2349End Class
     50
     51Namespace Detail
     52
     53Class ListBoxItemList
     54    Implements System.Collections.Generic.IList<String>
     55Public
     56    Sub ListBoxItemList(l As ListBox)
     57        base = l
     58    End Sub
     59
     60    Function GetEnumerator() As System.Collections.Generic.IEnumerator<String>
     61    End Function
     62
     63    Function Count() As Long
     64        Count = base.SendMessage(LB_GETCOUNT) As Long
     65        lrCheck(Count, "ListBox.Item.Count")
     66    End Function
     67
     68    Function IsReadOnly() As Boolean
     69        Return False
     70    End Function
     71
     72    Sub Add(s As String)
     73        lrCheck(base.SendMessage(LB_ADDSTRING, 0, ToTCStr(s) As LPARAM), "ListBox.Item.Add")
     74    End Sub
     75
     76    Sub Clear()
     77        Do : Loop Until removeAtImpl(0) = LB_ERR
     78    End Sub
     79
     80    Function Remove(s As String) As Boolean
     81        Dim i = IndexOf(s)
     82        If i = -1 Then
     83            Remove = False
     84        Else
     85            removeAtImpl(i)
     86            Remove = True
     87        End If
     88    End Function
     89
     90    Sub Operator [](index As Long, item As String)
     91        Item[index] = item
     92    End Sub
     93
     94    Function Operator [](index As Long) As String
     95        Return Item[index]
     96    End Function
     97
     98    Virtual Sub Item(i As Long, s As String)
     99        lrCheck(removeAtImpl(i), i, "ListBox.Item[] (set)")
     100        lrCheck(base.SendMessage(LB_INSERTSTRING, 0, ToTCStr(s) As LPARAM), i, "ListBox.Item[] (set)")
     101    End Sub
     102
     103    Virtual Function Item(i As Long) As String
     104        Dim len = base.SendMessage(LB_GETTEXTLEN, i As WPARAM, 0)
     105        lrCheck(len, i, "ListBox.Item[] (get)")
     106        Dim sb = New System.Text.StringBuilder(len)
     107        sb.Length = len
     108        len = base.SendMessage(LB_GETTEXT, i As WPARAM, StrPtr(sb) As LPARAM)
     109        lrCheck(len, i, "ListBox.Item[] (get)")
     110        sb.Length = len
     111        Item = sb.ToString
     112    End Function
     113
     114    Virtual Function IndexOf(s As String) As Long
     115        '見つからなかったときに返るLB_ERRはちょうど-1。
     116        IndexOf = base.SendMessage(LB_FINDSTRINGEXACT, -1 As WPARAM, ToTCStr(s) As LPARAM) As Long
     117    End Function
     118
     119    Virtual Sub Insert(i As Long, s As String)
     120        Dim lr = base.SendMessage(LB_INSERTSTRING, 0, ToTCStr(s) As LPARAM)
     121        lrCheck(lr, i, "ListBox.Item.Insert")
     122    End Sub
     123
     124    Virtual Sub RemoveAt(i As Long)
     125        Dim lr = removeAtImpl(i)
     126        lrCheck(lr, i, "ListBox.Item.RemoveAt")
     127    End Sub
     128Private
     129    Function removeAtImpl(i As Long) As LRESULT
     130        removeAtImpl = base.SendMessage(LB_DELETESTRING, i As WPARAM, 0)
     131    End Function
     132
     133    Sub lrCheck(lr As LRESULT, s As String)
     134        LRCheck(lr, s)
     135    End Sub
     136
     137    Sub lrCheck(lr As LRESULT, i As Long, s As String)
     138        LRCheck(lr, i, Count, s)
     139    End Sub
     140
     141    base As ListBox
     142End Class
     143
     144/*!
     145@brief List Boxからの戻り値がエラー値の場合に例外を投げる。
     146@param[in] lr SendMessageなどの戻り値
     147@param[in] s 例外を投げるときに添加するメッセージ
     148@throw SystemException lrがエラー値のとき
     149@date 2008/08/21
     150@auther Egtra
     151*/
     152Sub LRCheck(lr As LRESULT, s As String)
     153    If lr = LB_ERR Then
     154        Throw New System.SystemException(s & " (LB_ERR)")
     155    ElseIf lr = LB_ERRSPACE Then
     156        Throw New System.SystemException(s & " (LB_ERRSPACE)")
     157    End If
     158End Sub
     159
     160/*!
     161@brief List Boxからの戻り値がエラー値の場合に例外を投げる。
     162@param[in] lr SendMessageなどの戻り値
     163@param[in] i インデックス
     164@param[in] max インデックスの許容される最大値
     165@param[in] s 例外を投げるときに添加するメッセージ
     166@throw SystemException lrがエラー値のとき
     167@throw OutOfRangeException lrがLB_ERRで、なおかつiが範囲外のとき
     168@date 2008/08/21
     169@auther Egtra
     170こちらは、iが範囲外かならOutOfRangeExceptionを投げるのが特徴
     171*/
     172Sub LRCheck(lr As LRESULT, i As Long, max As Long, s As String)
     173    If lr = LB_ERR Then
     174        If i < 0 Or i >= max Then
     175            Throw New System.ArgumentOutOfRangeException(s)
     176        Else
     177            Throw New System.SystemException(s & " (LB_ERR)")
     178        End If
     179    ElseIf lr = LB_ERRSPACE Then
     180        Throw New System.SystemException(s & " (LB_ERRSPACE)")
     181    End If
     182End Sub
     183
     184End Namespace
    24185
    25186End Namespace 'UI
Note: See TracChangeset for help on using the changeset viewer.