Changeset 542 for trunk


Ignore:
Timestamp:
Jul 13, 2008, 2:29:17 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

Controlをデリゲートベースにした。DictionaryのContainsKeyとTryGetValueを実装。デリゲートの追加・削除の右辺にNothingを指定可能にした。

Location:
trunk/ab5.0/ablib/src/Classes
Files:
7 edited

Legend:

Unmodified
Added
Removed

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

    r473 r542  
    88Namespace Forms
    99
     10'Namespace Detail
     11'   TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
     12'End Namespace
     13
    1014Class Control
    1115Public
    … …  
    1923    End Sub
    2024
    21     Function Handle() As WindowHandle
    22         Handle = wnd
     25    Function Handle() As HWND
     26        Handle = hwnd
    2327    End Function
    2428
    … …  
    5357        menu = 0 As HMENU) As HWND
    5458*/
     59
    5560Public
    5661    Function Create() As Boolean
    … …  
    7176        TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
    7277
     78        StartWndProc()
     79
    7380        With cs
    7481            Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
    … …  
    8390Public
    8491    Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
     92/*
    8593        Select Case msg
    86             Case WM_ERASEBKGND
    87                 Dim rc = wnd.ClientRect
    88                 Dim e = New PaintDCHandledEventArgs(wp As HDC, rc)
    89                 OnPaintBackground(e)
    90                 WndProc = e.Handled
    91             Case WM_PAINT
    92                 Dim ps As PAINTSTRUCT
    93                 wnd.BeginPaint(ps)
    94                 Try
    95                     Dim e = New PaintDCEventArgs(ps.hdc, ps.rcPaint)
    96                     OnPaintDC(e)
    97                 Finally
    98                     wnd.EndPaint(ps)
    99                 End Try
    100             Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN, WM_XBUTTONDOWN
    101                 OnMouseDown(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0))
    102             Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP, WM_XBUTTONUP
    103                 OnMouseUp(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0))
    104 /*
     94            Case WM_MOUSELEAVE
     95                OnMouseLeave(makeMouseEventFromWPLP(wp, lp))
     96                mouseEntered = False
    10597            Case WM_KEYDOWN
    10698                OnKeyDown(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
    … …  
    108100                OnKeyUp(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
    109101            Case WM_CHAR
    110                 OnKeyPress(New KeyPressEventArgs(wParam As Char))
    111             Case WM_ENABLE
    112                 OnEnableChanged(EventArgs.Empty)
    113             Case WM_MOVE
    114                 OnMove(EventArgs.Empty)
    115             Case WM_SIZE
    116                 OnResize(EventArgs.Empty)
     102                OnKeyPress(New KeyPressEventArgs(wp As Char))
     103'           Case WM_CREATE
     104            Case WM_DESTROY
     105                OnDestroy(EventArgs.Empty)
     106            Case Else
     107                WndProc = DefWndProc(msg, wp, lp)
     108        End Select
    117109*/
    118             Case Else
    119             WndProc = DefWndProc(msg, wp, lp)
    120         End Select
     110        Dim h = Nothing As MessageEventHandler
     111        Dim b = messageMap.TryGetValue(Hex$(msg), h)
     112        If b Then
     113            If Not IsNothing(h) Then
     114                Dim a = New MessageEventArgs(hwnd, msg, wp, lp)
     115                h(This, a)
     116                WndProc = a.LResult
     117                Exit Function
     118            End If
     119        End If
     120        WndProc = DefWndProc(msg, wp, lp)
    121121    End Function
    122122
    123123    Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    124         DefWndProc = DefWindowProc(wnd.HWnd, msg, wp, lp)
    125     End Function
    126 
    127 Private
    128     Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
     124        DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
     125    End Function
     126
     127Private
     128    Static Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
    129129        Dim t As DWord
    130130        t = wp And Keys.KeyCode
    … …  
    135135    End Function
    136136
    137 
    138 '--------------------------------
    139 ' ウィンドウメッセージ処理
    140 
    141 '--------
    142 ' 2
    143 
    144 Protected
     137    Static Function makeMouseEventFromWPLP(wp As WPARAM, lp As LPARAM) As MouseEventArgs
     138        makeMouseEventFromWPLP = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
     139    End Function
     140
    145141    /*!
    146     @biref  ウィンドウの背景を描画する。
     142    @brief  最初にウィンドウプロシージャが呼ばれるときに実行される関数
     143    ここでは、主なメッセージハンドラの登録を行っている。
     144    @date   2008/07/11
     145    */
     146    Sub StartWndProc()
     147        Dim t = This '#177対策
     148        messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
     149        AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
     150        Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
     151        AddMessageEvent(WM_LBUTTONDOWN, md)
     152        AddMessageEvent(WM_RBUTTONDOWN, md)
     153        AddMessageEvent(WM_MBUTTONDOWN, md)
     154        AddMessageEvent(WM_XBUTTONDOWN, md)
     155        Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase))
     156        AddMessageEvent(WM_LBUTTONUP, mu)
     157        AddMessageEvent(WM_RBUTTONUP, mu)
     158        AddMessageEvent(WM_MBUTTONUP, mu)
     159        AddMessageEvent(WM_XBUTTONUP, mu)
     160        Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase))
     161        AddMessageEvent(WM_LBUTTONDBLCLK, mu)
     162        AddMessageEvent(WM_RBUTTONDBLCLK, mu)
     163        AddMessageEvent(WM_MBUTTONDBLCLK, mu)
     164        AddMessageEvent(WM_XBUTTONDBLCLK, mu)
     165        AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
     166    End Sub
     167
     168    Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
     169        Dim rc As RECT
     170        Dim r = GetClientRect(hwnd, rc)
     171        FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
     172        e.LResult = TRUE
     173    End Sub
     174
     175    Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
     176        OnMouseDown(makeMouseEventFromWPLP(e.WParam, e.LParam))
     177    End Sub
     178
     179    Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
     180        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     181        If doubleClickFired = False Then
     182            OnClick(EventArgs.Empty)
     183            OnMouseClick(me)
     184            doubleClickFired = False
     185        End If
     186        OnMouseUp(me)
     187    End Sub
     188
     189    Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
     190        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     191        doubleClickFired = True
     192        OnMouseDown(me)
     193        OnDoubleClick(EventArgs.Empty)
     194        OnMouseDoubleClick(me)
     195    End Sub
     196
     197    Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
     198        Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     199        If mouseEntered Then
     200            OnMouseMove(me)
     201        Else
     202            mouseEntered = True
     203            OnMouseEnter(me)
     204        End If
     205    End Sub
     206
     207    Sub OnPaintBase(sender As Object, e As MessageEventArgs)
     208        Dim ps As PAINTSTRUCT
     209        BeginPaint(hwnd, ps)
     210'       Try
     211'           OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
     212'       Finally
     213            EndPaint(hwnd, ps)
     214'       End Try
     215    End Sub
     216
     217
     218    messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
     219
     220Public
     221    /*!
     222    @biref  メッセージイベントハンドラを登録する。
    147223    @date   2007/12/04
    148224    */
    149     Virtual Sub OnPaintBackground(e As PaintDCBackGroundEventArgs)
    150         Dim hbr = (COLOR_3DFACE + 1) As HBRUSH
    151         FillRect(e.Handle, e.ClipRect, hbr)
    152         e.Handled = True
    153     End Sub
     225    Sub AddMessageEvent(message As DWord, h As MessageEventHandler)
     226        If Not IsNothing(h) Then
     227            If IsNothing(messageMap) Then
     228                messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
     229            End If
     230            Dim msg = Hex$(message)
     231            Dim m = Nothing As MessageEventHandler
     232            If messageMap.TryGetValue(msg, m) Then
     233                messageMap.Item[msg] = m + h
     234            Else
     235                messageMap.Item[msg] = h
     236            End If
     237        End If
     238    End Sub
     239
     240    /*!
     241    @biref  メッセージイベントハンドラ登録を解除する。
     242    @date   2007/12/04
     243    */
     244    Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler)
     245        If Not IsNothing(a) Then
     246            If Not IsNothing(messageMap) Then
     247                Dim msg = Nothing As Object : msg = New System.UInt32(message)
     248                Dim m = messageMap.Item[msg]
     249                If Not IsNothing(m) Then
     250                    messageMap.Item[msg] = m - a
     251                End If
     252            End If
     253        End If
     254    End Sub
     255
     256'--------------------------------
     257' ウィンドウメッセージ処理
     258
    154259
    155260'--------
    … …  
    162267' 1 インスタンスメンバ変数
    163268Private
    164     wnd As WindowHandle
     269    hwnd As HWND
     270    /*!
     271    @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
     272    外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
     273    */
     274    mouseEntered As Boolean
     275    /*!
     276    @brief ダブルクリックが起こったかどうかのフラグ
     277    Click/MouseClickイベントのために用意している。
     278    @date   2008/07/12
     279    */
     280    doubleClickFired As Boolean
    165281
    166282'--------------------------------
    … …  
    184300                Goto *InstanceIsNotFound
    185301            End If
    186             rThis.wnd = New WindowHandle(hwnd)
    187             rThis.wnd.SetProp(PropertyInstance, gchValue As HANDLE)
     302            rThis.hwnd = hwnd
     303            SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE)
    188304        End If
    189305        WndProcFirst = rThis.WndProc(msg, wp, lp)
    … …  
    202318        WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
    203319    End Function
    204    
     320
    205321'   Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
    206322'   Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
    207323
    208324'--------------------------------
     325'   その他の補助関数
     326Private
     327'   Sub tracMouseEvent()
     328/*      If pTrackMouseEvent <> 0 Then
     329            Dim tme As TRACKMOUSEEVENT
     330            With tme
     331                .cbSize = Len(tme)
     332                .dwFlags = TME_HOVER Or TME_LEAVE
     333                .hwndTrack = wnd
     334                .dwHoverTime = HOVER_DEFAULT
     335            End With
     336            pTrackMouseEvent(tme)
     337        End If
     338*/  'End Sub
     339
     340'--------------------------------
    209341' 1 初期化終了関連（特にウィンドウクラス）
    210 
     342Private
    211343    'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
    212344    Static tlsIndex As DWord
    … …  
    214346    Static hInstance As HINSTANCE
    215347    Static atom As ATOM
     348    Static hmodComctl As HMODULE
     349'   Static pTrackMouseEvent As PTrackMouseEvent
    216350
    217351    Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
    … …  
    221355        tlsIndex = TlsAlloc()
    222356        hInstance = hinst
     357'       hmodComctl = LoadLibrary("comctl32.dll")
     358'       pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent"))
    223359
    224360        Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
    … …  
    251387
    252388    Static Sub Uninitialize()
    253         UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
    254         TlsFree(tlsIndex)
    255         GlobalDeleteAtom(PropertyInstance)
    256     End Sub
     389        If atom <> 0 Then
     390            UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
     391        End If
     392        If tlsIndex <> 0 And tlsIndex <> &hffffffff Then
     393            TlsFree(tlsIndex)
     394        End If
     395'       If hmodComctl <> 0 Then
     396'           FreeLibrary(hmodComctl)
     397'       End If
     398        If PropertyInstance <> 0 Then
     399            GlobalDeleteAtom(PropertyInstance)
     400        End If
     401    End Sub
     402
    257403End Class
    258404
    259 Namespace Detail
    260 Class _System_ControlIinitializer
    261 Public
    262     Sub _System_ControlIinitializer(hinst As HINSTANCE)
    263         Control.Initialize(hinst)
    264     End Sub
    265 
    266     Sub ~_System_ControlIinitializer()
    267         Control.Uninitialize()
    268     End Sub
    269 End Class
    270 
    271 #ifndef _SYSTEM_NO_INITIALIZE_CONTROL_
    272 Dim _System_ControlInitializer As _System_ControlIinitializer(GetModuleHandle(0))
    273 #endif '_SYSTEM_NO_INITIALIZE_CONTROL_
    274 
    275 End Namespace 'Detail
    276 
    277 Class Form
     405Class Form '仮
    278406    Inherits Control
    279407Protected
    … …  
    294422        End With
    295423    End Sub
    296 Public '仮
     424Public
     425
    297426    Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    298427        WndProc = 0
    299428        Select Case msg
    300             Case WM_DESTROY
    301                 PostQuitMessage(0)
    302429            Case Else
    303430                WndProc = Super.WndProc(msg, wp, lp)
    … …  
    311438End Namespace 'ActiveBasic
    312439
     440
    313441'----------
    314442'テスト実行用
    … …  
    316444Imports ActiveBasic.Windows.UI.Forms
    317445
    318 Class Bar
    319 Public
    320 Static Sub PaintDCEvent(sender As Object, et As PaintDCEventArgs)
    321     Dim e = et As PaintDCEventArgs
    322     TextOut(e.Handle, 10, 10, "Hello, world", 12)
    323 End Sub
     446'OleInitialize()
     447Control.Initialize(GetModuleHandle(0))
     448
     449Class MyForm
     450    Inherits Form
     451Public
     452    Sub NcDestory(sender As Object, et As EventArgs)
     453        PostQuitMessage(0)
     454    End Sub
    324455End Class
    325456
    326 Dim f = New Form
     457Dim f = New MyForm
    327458f.Create()
    328 Dim v = New PaintDCEventHandler(AddressOf (Bar.PaintDCEvent))
    329 f.AddPaintDC(v)
    330 f.Handle.Show(SW_SHOW)
    331 
    332 MessageBox(0, "hello", "", 0)
     459Dim h = New MessageEventHandler(AddressOf (f.NcDestory))
     460f.AddMessageEvent(WM_NCDESTROY, h)
     461ShowWindow(f.Handle, SW_SHOW)
     462
     463Dim m As MSG
     464Do
     465    Dim ret = GetMessage(m, 0, 0, 0)
     466    If ret = 0 Then
     467        Exit Do
     468    ElseIf ret = -1 Then
     469        ExitProcess(-1)
     470    End If
     471
     472    TranslateMessage(m)
     473    DispatchMessage(m)
     474Loop
     475
     476f = Nothing
     477System.GC.Collect()
     478
     479Control.Uninitialize()
     480'OleUninitialize()
     481
     482End
     483

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp

    r473 r542  
    1 Public
    2     /*!
    3     @brief PaintDCイベントハンドラを追加する
    4     */
     1
     2Public
    53    Sub AddPaintDC(h As PaintDCEventHandler)
    64        If IsNothing(paintDC) Then
    7             paintDC = New PaintDCEventHandler
    8         End If
    9         paintDC += h
    10     End Sub
    11     /*!
    12     @brief PaintDCイベントハンドラを削除する
    13     */
     5            paintDC = h
     6        Else
     7            paintDC += h
     8        End If
     9    End Sub
    1410    Sub RemovePaintDC(h As PaintDCEventHandler)
    1511        If Not IsNothing(paintDC) Then
    … …  
    1713        End If
    1814    End Sub
    19 Protected
    20     /*!
    21     @brief ウィンドウの描画が必要なときに呼び出されます。
    22     */
    23     Virtual Sub OnPaintDC(e As PaintDCEventArgs)
     15Private
     16    Sub OnPaintDC(e As PaintDCEventArgs)
    2417        If Not IsNothing(paintDC) Then
    2518            paintDC(This, e)
    … …  
    3023
    3124Public
    32     /*!
    33     @brief Clickイベントハンドラを追加する
    34     */
    35     Sub AddClick(h As EventHandler)
     25    Sub AddClick(h As System.EventHandler)
    3626        If IsNothing(click) Then
    37             click = New EventHandler
    38         End If
    39         click += h
    40     End Sub
    41     /*!
    42     @brief Clickイベントハンドラを削除する
    43     */
    44     Sub RemoveClick(h As EventHandler)
     27            click = h
     28        Else
     29            click += h
     30        End If
     31    End Sub
     32    Sub RemoveClick(h As System.EventHandler)
    4533        If Not IsNothing(click) Then
    4634            click -= h
    4735        End If
    4836    End Sub
    49 Protected
    50     /*!
    51     @brief クリックされたときに呼び出されます。
    52     */
    53     Virtual Sub OnClick(e As EventArgs)
     37Private
     38    Sub OnClick(e As System.EventArgs)
    5439        If Not IsNothing(click) Then
    5540            click(This, e)
    … …  
    5742    End Sub
    5843Private
    59     click As EventHandler
    60 
    61 Public
    62     /*!
    63     @brief DoubleClickイベントハンドラを追加する
    64     */
    65     Sub AddDoubleClick(h As EventHandler)
     44    click As System.EventHandler
     45
     46Public
     47    Sub AddDoubleClick(h As System.EventHandler)
    6648        If IsNothing(doubleClick) Then
    67             doubleClick = New EventHandler
    68         End If
    69         doubleClick += h
    70     End Sub
    71     /*!
    72     @brief DoubleClickイベントハンドラを削除する
    73     */
    74     Sub RemoveDoubleClick(h As EventHandler)
     49            doubleClick = h
     50        Else
     51            doubleClick += h
     52        End If
     53    End Sub
     54    Sub RemoveDoubleClick(h As System.EventHandler)
    7555        If Not IsNothing(doubleClick) Then
    7656            doubleClick -= h
    7757        End If
    7858    End Sub
    79 Protected
    80     /*!
    81     @brief ダブルクリックされたときに呼び出されます。
    82     */
    83     Virtual Sub OnDoubleClick(e As EventArgs)
     59Private
     60    Sub OnDoubleClick(e As System.EventArgs)
    8461        If Not IsNothing(doubleClick) Then
    8562            doubleClick(This, e)
    … …  
    8764    End Sub
    8865Private
    89     doubleClick As EventHandler
    90 
    91 Public
    92     /*!
    93     @brief MouseDownイベントハンドラを追加する
    94     */
     66    doubleClick As System.EventHandler
     67
     68Public
     69    Sub AddMouseEnter(h As MouseEventHandler)
     70        If IsNothing(mouseEnter) Then
     71            mouseEnter = h
     72        Else
     73            mouseEnter += h
     74        End If
     75    End Sub
     76    Sub RemoveMouseEnter(h As MouseEventHandler)
     77        If Not IsNothing(mouseEnter) Then
     78            mouseEnter -= h
     79        End If
     80    End Sub
     81Private
     82    Sub OnMouseEnter(e As MouseEventArgs)
     83        If Not IsNothing(mouseEnter) Then
     84            mouseEnter(This, e)
     85        End If
     86    End Sub
     87Private
     88    mouseEnter As MouseEventHandler
     89
     90Public
     91    Sub AddMouseMove(h As MouseEventHandler)
     92        If IsNothing(mouseMove) Then
     93            mouseMove = h
     94        Else
     95            mouseMove += h
     96        End If
     97    End Sub
     98    Sub RemoveMouseMove(h As MouseEventHandler)
     99        If Not IsNothing(mouseMove) Then
     100            mouseMove -= h
     101        End If
     102    End Sub
     103Private
     104    Sub OnMouseMove(e As MouseEventArgs)
     105        If Not IsNothing(mouseMove) Then
     106            mouseMove(This, e)
     107        End If
     108    End Sub
     109Private
     110    mouseMove As MouseEventHandler
     111
     112Public
     113    Sub AddMouseHover(h As MouseEventHandler)
     114        If IsNothing(mouseHover) Then
     115            mouseHover = h
     116        Else
     117            mouseHover += h
     118        End If
     119    End Sub
     120    Sub RemoveMouseHover(h As MouseEventHandler)
     121        If Not IsNothing(mouseHover) Then
     122            mouseHover -= h
     123        End If
     124    End Sub
     125Private
     126    Sub OnMouseHover(e As MouseEventArgs)
     127        If Not IsNothing(mouseHover) Then
     128            mouseHover(This, e)
     129        End If
     130    End Sub
     131Private
     132    mouseHover As MouseEventHandler
     133
     134Public
     135    Sub AddMouseLeave(h As MouseEventHandler)
     136        If IsNothing(mouseLeave) Then
     137            mouseLeave = h
     138        Else
     139            mouseLeave += h
     140        End If
     141    End Sub
     142    Sub RemoveMouseLeave(h As MouseEventHandler)
     143        If Not IsNothing(mouseLeave) Then
     144            mouseLeave -= h
     145        End If
     146    End Sub
     147Private
     148    Sub OnMouseLeave(e As MouseEventArgs)
     149        If Not IsNothing(mouseLeave) Then
     150            mouseLeave(This, e)
     151        End If
     152    End Sub
     153Private
     154    mouseLeave As MouseEventHandler
     155
     156Public
    95157    Sub AddMouseDown(h As MouseEventHandler)
    96158        If IsNothing(mouseDown) Then
    97             mouseDown = New MouseEventHandler
    98         End If
    99         mouseDown += h
    100     End Sub
    101     /*!
    102     @brief MouseDownイベントハンドラを削除する
    103     */
     159            mouseDown = h
     160        Else
     161            mouseDown += h
     162        End If
     163    End Sub
    104164    Sub RemoveMouseDown(h As MouseEventHandler)
    105165        If Not IsNothing(mouseDown) Then
    … …  
    107167        End If
    108168    End Sub
    109 Protected
    110     /*!
    111     @brief マウスボタンが押されたときに呼び出されます。
    112     */
    113     Virtual Sub OnMouseDown(e As MouseEventArgs)
     169Private
     170    Sub OnMouseDown(e As MouseEventArgs)
    114171        If Not IsNothing(mouseDown) Then
    115172            mouseDown(This, e)
    … …  
    120177
    121178Public
    122     /*!
    123     @brief MouseUpイベントハンドラを追加する
    124     */
     179    Sub AddMouseClick(h As MouseEventHandler)
     180        If IsNothing(mouseClick) Then
     181            mouseClick = h
     182        Else
     183            mouseClick += h
     184        End If
     185    End Sub
     186    Sub RemoveMouseClick(h As MouseEventHandler)
     187        If Not IsNothing(mouseClick) Then
     188            mouseClick -= h
     189        End If
     190    End Sub
     191Private
     192    Sub OnMouseClick(e As MouseEventArgs)
     193        If Not IsNothing(mouseClick) Then
     194            mouseClick(This, e)
     195        End If
     196    End Sub
     197Private
     198    mouseClick As MouseEventHandler
     199
     200Public
     201    Sub AddMouseDoubleClick(h As MouseEventHandler)
     202        If IsNothing(mouseDoubleClick) Then
     203            mouseDoubleClick = h
     204        Else
     205            mouseDoubleClick += h
     206        End If
     207    End Sub
     208    Sub RemoveMouseDoubleClick(h As MouseEventHandler)
     209        If Not IsNothing(mouseDoubleClick) Then
     210            mouseDoubleClick -= h
     211        End If
     212    End Sub
     213Private
     214    Sub OnMouseDoubleClick(e As MouseEventArgs)
     215        If Not IsNothing(mouseDoubleClick) Then
     216            mouseDoubleClick(This, e)
     217        End If
     218    End Sub
     219Private
     220    mouseDoubleClick As MouseEventHandler
     221
     222Public
    125223    Sub AddMouseUp(h As MouseEventHandler)
    126224        If IsNothing(mouseUp) Then
    127             mouseUp = New MouseEventHandler
    128         End If
    129         mouseUp += h
    130     End Sub
    131     /*!
    132     @brief MouseUpイベントハンドラを削除する
    133     */
     225            mouseUp = h
     226        Else
     227            mouseUp += h
     228        End If
     229    End Sub
    134230    Sub RemoveMouseUp(h As MouseEventHandler)
    135231        If Not IsNothing(mouseUp) Then
    … …  
    137233        End If
    138234    End Sub
    139 Protected
    140     /*!
    141     @brief マウスボタンが離されたときに呼び出されます。
    142     */
    143     Virtual Sub OnMouseUp(e As MouseEventArgs)
     235Private
     236    Sub OnMouseUp(e As MouseEventArgs)
    144237        If Not IsNothing(mouseUp) Then
    145238            mouseUp(This, e)
    … …  
    149242    mouseUp As MouseEventHandler
    150243
     244Public
     245    Sub AddKeyDown(h As KeyEventHandler)
     246        If IsNothing(keyDown) Then
     247            keyDown = h
     248        Else
     249            keyDown += h
     250        End If
     251    End Sub
     252    Sub RemoveKeyDown(h As KeyEventHandler)
     253        If Not IsNothing(keyDown) Then
     254            keyDown -= h
     255        End If
     256    End Sub
     257Private
     258    Sub OnKeyDown(e As KeyEventArgs)
     259        If Not IsNothing(keyDown) Then
     260            keyDown(This, e)
     261        End If
     262    End Sub
     263Private
     264    keyDown As KeyEventHandler
     265
     266Public
     267    Sub AddKeyUp(h As KeyEventHandler)
     268        If IsNothing(keyUp) Then
     269            keyUp = h
     270        Else
     271            keyUp += h
     272        End If
     273    End Sub
     274    Sub RemoveKeyUp(h As KeyEventHandler)
     275        If Not IsNothing(keyUp) Then
     276            keyUp -= h
     277        End If
     278    End Sub
     279Private
     280    Sub OnKeyUp(e As KeyEventArgs)
     281        If Not IsNothing(keyUp) Then
     282            keyUp(This, e)
     283        End If
     284    End Sub
     285Private
     286    keyUp As KeyEventHandler
     287/*
     288Public
     289    Sub AddKeyPress(h As KeyPressEventHandler)
     290        If IsNothing(keyPress) Then
     291            keyPress = h
     292        Else
     293            keyPress += h
     294        End If
     295    End Sub
     296    Sub RemoveKeyPress(h As KeyPressEventHandler)
     297        If Not IsNothing(keyPress) Then
     298            keyPress -= h
     299        End If
     300    End Sub
     301Private
     302    Sub OnKeyPress(e As KeyPressEventArgs)
     303        If Not IsNothing(keyPress) Then
     304            keyPress(This, e)
     305        End If
     306    End Sub
     307Private
     308    keyPress As KeyPressEventHandler
     309
     310Public
     311    Sub AddCreate(h As CreateEventHandler)
     312        If IsNothing(create) Then
     313            create = h
     314        Else
     315            create += h
     316        End If
     317    End Sub
     318    Sub RemoveCreate(h As CreateEventHandler)
     319        If Not IsNothing(create) Then
     320            create -= h
     321        End If
     322    End Sub
     323Private
     324    Sub OnCreate(e As CreateEventArgs)
     325        If Not IsNothing(create) Then
     326            create(This, e)
     327        End If
     328    End Sub
     329Private
     330    create As CreateEventHandler
     331*/

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt

    r473 r542  
    66'Resize Event   ウィンドウの大きさが変化したときに呼び出されます。
    77'VisibleChanged Event   ウィンドウの表示状態が変化したときに呼び出されます。
    8 'GotFocus   Event   フォーカスを得たときに呼び出されます。
    9 'LostFocus  Event   フォーカスを失ったときに呼び出されます。
    10 'MouseEnter MouseEvent  マウスカーソルがコントロールに入ってくると呼び出されます。
    11 'MouseMove  MouseEvent  マウスカーソルがコントロール上で移動すると呼び出されます
    12 'MouseHover MouseEvent  マウスカーソルがコントロール上で静止すると呼び出されます。
    13 'MouseLeave MouseEvent  マウスカーソルがコントロールから出て行くと呼び出されます。
     8'SetFocus   Event   フォーカスを得たときに呼び出されます。
     9'KillFocus  Event   フォーカスを失ったときに呼び出されます。
     10MouseEnter  MouseEvent  マウスカーソルがコントロールに入ってくると呼び出されます。
     11MouseMove   MouseEvent  マウスカーソルがコントロール上で移動すると呼び出されます
     12MouseHover  MouseEvent  マウスカーソルがコントロール上で静止すると呼び出されます。
     13MouseLeave  MouseEvent  マウスカーソルがコントロールから出て行くと呼び出されます。
    1414MouseDown   MouseEvent  マウスボタンが押されたときに呼び出されます。
    15 'MouseClick MouseEvent  マウスでクリックされたときに呼び出されます。
    16 'MouseDoubleClick   MouseEvent  マウスでダブルクリックされたときに呼び出されます。
     15MouseClick  MouseEvent  マウスでクリックされたときに呼び出されます。
     16MouseDoubleClick    MouseEvent  マウスでダブルクリックされたときに呼び出されます。
    1717MouseUp MouseEvent  マウスボタンが離されたときに呼び出されます。
    1818'MouseWheel MouseEvent  マウスホイールが回されたときに呼び出されます。
    19 'KeyDown    KeyEvent    キーが押されたときに呼ばれます。
    20 'KeyUp  KeyEvent    キーが離されたときに呼ばれます。
    21 'KeyPress   KeyPressEvent   キーが押されて文字が打たれたときに呼ばれます。
     19KeyDown KeyEvent    キーが押されたときに呼ばれます。
     20KeyUp   KeyEvent    キーが離されたときに呼ばれます。
     21'なぜかコンパイルエラーを起こすのでコメントアウト KeyPress  KeyPressEvent   キーが押されて文字が打たれたときに呼ばれます。
     22Create  CreateEvent ウィンドウが作成されたときに呼ばれます。
     23'Destroy    Event   ウィンドウが破棄されるときに呼ばれます。

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

    r473 r542  
    1111TypeDef EventArgs = System.EventArgs
    1212TypeDef EventHandler = System.EventHandler
     13
     14Class MessageEventArgs
     15    Inherits EventArgs
     16Public
     17    Sub MessageEventArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM)
     18        msg = message
     19'       hwnd = hwndSrc
     20        wp = wParam
     21        lp = lParam
     22        lr = 0
     23    End Sub
     24
     25    Function Msg() As DWord
     26        Msg = msg
     27    End Function
     28
     29'   Function HWnd() As HWND
     30'       HWnd = hwnd
     31'   End Function
     32
     33    Function WParam() As WPARAM
     34        WParam = wp
     35    End Function
     36
     37    Function LParam() As LPARAM
     38        LParam = lp
     39    End Function
     40
     41    Function LResult() As LRESULT
     42        LResult = lr
     43    End Function
     44
     45    Sub LResult(lResult As LRESULT)
     46        lr = lResult
     47    End Sub
     48Private
     49    msg As DWord
     50'   hwnd As HWND
     51    wp As WPARAM
     52    lp As LPARAM
     53    lr As LRESULT
     54End Class
     55
     56Delegate Sub MessageEventHandler(sender As Object, e As MessageEventArgs)
    1357
    1458Class PaintDCEventArgs
    … …  
    63107    XButton1 = MK_XBUTTON1
    64108    XButton2 = MK_XBUTTON2
     109
     110    Shift = MK_SHIFT
     111    Control = MK_CONTROL
    65112End Enum
    66113
    … …  
    352399
    353400    Function KeyCode() As Keys
    354         KeyCode = key And Keys.KeyCode
     401        Dim k = key As DWord
     402        Dim mask = Keys.KeyCode As DWord
     403        KeyCode = (k And mask) As Keys
    355404    End Function
    356405
    … …  
    360409
    361410    Function Modifiers() As Keys
    362         Modifiers = key And Keys.Modifiers
     411        Dim k = key As DWord
     412        Dim mask = Keys.Modifiers As DWord
     413        Modifiers = (k And mask) As Keys
    363414    End Function
    364415
    … …  
    381432
    382433Delegate Sub KeyEventHandler(sender As Object, e As KeyEventArgs)
     434
     435Class CreateEventArgs
     436    Inherits EventArgs
     437Public
     438    Sub CreateEventArgs(pCreateStruct As *CREATESTRUCT)
     439        pcs = pCreateStruct
     440    End Sub
     441
     442    Const Function HInstance() As HINSTANCE
     443        HInstance = pcs->hInstance
     444    End Function
     445
     446    'Menu: pcs->hMenu
     447
     448    Const Function Parent() As Control
     449        'Parent = Control.FromHandle(pcs->hwndParent)
     450    End Function
     451
     452    Const Function Height() As Long
     453        Height = pcs->cy
     454    End Function
     455
     456    Const Function Width() As Long
     457        Width = pcs->cx
     458    End Function
     459
     460    Const Function Y() As Long
     461        Y = pcs->cy
     462    End Function
     463
     464    Const Function X() As Long
     465        X = pcs->cx
     466    End Function
     467
     468    Const Function Style() As DWord
     469        Style = pcs->style As DWord
     470    End Function
     471
     472    Const Function Caption() As String
     473        Caption = New String(pcs->lpszName)
     474    End Function
     475
     476    Const Function ClassName() As String
     477        ClassName = New String(pcs->lpszClass)
     478    End Function
     479
     480    Const Function ExStyle() As DWord
     481        ExStyle = pcs->dwExStyle
     482    End Function
     483
     484    Const Function CreateStruct() As *CREATESTRUCT
     485        CreateStruct = pcs
     486    End Function
     487Private
     488    pcs As *CREATESTRUCT
     489End Class
     490
     491Delegate Sub CreateEventHandler(sender As Object, e As CreateEventArgs)
    383492
    384493End Namespace 'Forms

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

    r473 r542  
    2222    Dim argsType = argBase & "Args"
    2323    out.WriteLine("Public")
    24     out.WriteLine(Ex"\t/*!")
    25     out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する")
    26     out.WriteLine(Ex"\t*/")
     24'   out.WriteLine(Ex"\t/*!")
     25'   out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する")
     26'   out.WriteLine(Ex"\t*/")
    2727    out.WriteLine(Ex"\tSub Add" & eventName & "(h As " & handlerType & ")")
    2828    out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then")
    29     out.WriteLine(Ex"\t\t\t" & eventMember & " = New " & handlerType)
     29    out.WriteLine(Ex"\t\t\t" & eventMember & " = h")
     30    out.WriteLine(Ex"\t\tElse")
     31    out.WriteLine(Ex"\t\t\t" & eventMember & " += h")
    3032    out.WriteLine(Ex"\t\tEnd If")
    31     out.WriteLine(Ex"\t\t" & eventMember & " += h")
    3233    out.WriteLine(Ex"\tEnd Sub")
    33     out.WriteLine(Ex"\t/*!")
    34     out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する")
    35     out.WriteLine(Ex"\t*/")
     34'   out.WriteLine(Ex"\t/*!")
     35'   out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する")
     36'   out.WriteLine(Ex"\t*/")
    3637    out.WriteLine(Ex"\tSub Remove" & eventName & "(h As " & handlerType & ")")
    3738    out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
    … …  
    3940    out.WriteLine(Ex"\t\tEnd If")
    4041    out.WriteLine(Ex"\tEnd Sub")
    41     out.WriteLine("Protected")
    42     out.WriteLine(Ex"\t/*!")
    43     out.WriteLine(Ex"\t@brief " & comment)
    44     out.WriteLine(Ex"\t*/")
    45     out.WriteLine(Ex"\tVirtual Sub On" & eventName & "(e As " & argsType & ")")
     42    out.WriteLine("Private")
     43'   out.WriteLine(Ex"\t/*!")
     44'   out.WriteLine(Ex"\t@brief " & comment)
     45'   out.WriteLine(Ex"\t*/")
     46    out.WriteLine(Ex"\tSub On" & eventName & "(e As " & argsType & ")")
    4647    out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then")
    4748    out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)")
    … …  
    5354End Sub
    5455
    55 'OutputEventHandlerCode("PaintDC", "PaintDCEventHandler", 
     56'OutputEventHandlerCode("PaintDC", "PaintDCEventHandler",
    5657'   "ウィンドウの描画が必要なときに呼び出されます。")
    5758

  • trunk/ab5.0/ablib/src/Classes/System/Collections/Generic/Dictionary.ab

    r537 r542  
    4747        Dim a = al[hash] As ArrayList
    4848
    49         If Not Object.ReferenceEquals(a, Nothing) Then
     49        If Not ActiveBasic.IsNothing(a) Then
    5050            Dim i As Long
    5151            For i = 0 To ELM(a.Count)
    … …  
    7777                If pair.Key.Equals(key) Then
    7878                    pair.Value = value
     79                    Exit Sub
    7980                End If
    8081            Next
    … …  
    135136    End Function
    136137
    137 '   Function ContainsKey(key As Key) As Boolean
    138 '   End Function
     138    /*!
     139    @biref  指定されたキーが格納されているか調べる。
     140    @date   2008/07/11
     141    @param[in] key  検索対象のキー
     142    @retval True    格納されていたとき
     143    @retval False   格納されていなかったとき
     144    @throw ArgumentNullException    keyがNothingだったとき
     145    @author Egtra
     146    */
     147    Function ContainsKey(key As Key) As Boolean
     148        If ActiveBasic.IsNothing(key) Then
     149            Throw New ArgumentNullException("key")
     150        End If
     151        ContainsKey = False
     152
     153        Dim hash = getHash(key)
     154        Dim a = al[hash] As ArrayList
     155
     156        If Not ActiveBasic.IsNothing(a) Then
     157            Dim i As Long
     158            For i = 0 To ELM(a.Count)
     159                Dim pair = a[i] As Detail.Pair
     160                If pair.Key.Equals(key) Then
     161                    ContainsKey = True
     162                    Exit Function
     163                End If
     164            Next
     165        End If
     166    End Function
     167
    139168'   Function ContainsValue(value As T) As Boolean
    140169'   End Function
    … …  
    169198    End Function
    170199
    171 '   Function TryGetValue(key As Key, ByRef value As T) As Boolean
    172 '   End Function
     200    Function TryGetValue(key As Key, ByRef value As T) As Boolean
     201        If ActiveBasic.IsNothing(key) Then
     202            Throw New ArgumentNullException("key")
     203        End If
     204        TryGetValue = False
     205        value = Nothing
     206
     207        Dim hash = getHash(key)
     208        Dim a = al[hash] As ArrayList
     209
     210        If Not ActiveBasic.IsNothing(a) Then
     211            Dim i As Long
     212            For i = 0 To ELM(a.Count)
     213                Dim pair = a[i] As Detail.Pair
     214                If pair.Key.Equals(key) Then
     215                    TryGetValue = True
     216                    value = pair.Value
     217                    Exit Function
     218                End If
     219            Next
     220        End If
     221    End Function
    173222
    174223    'Classses

  • trunk/ab5.0/ablib/src/Classes/System/Delegate.ab

    r352 r542  
    2929
    3030    Sub _Add( dg As DelegateBase )
    31         Dim i As Long
    32         For i=0 To ELM(dg.simpleDelegates.Count)
    33             simpleDelegates.Add( dg.simpleDelegates[i] )
    34         Next
     31        If Not ActiveBasic.IsNothing(dg) Then
     32            Dim i As Long
     33            For i=0 To ELM(dg.simpleDelegates.Count)
     34                simpleDelegates.Add( dg.simpleDelegates[i] )
     35            Next
     36        End If
    3537    End Sub
    3638
    3739    Sub _Delete( dg As DelegateBase )
    38         Dim i As Long
    39         For i=0 To ELM(This.simpleDelegates.Count)
    40             Dim i2 As Long
    41             Dim isExist = False
    42             For i2=0 To ELM(dg.simpleDelegates.Count)
    43                 If This.simpleDelegates[i].IsEqual( dg.simpleDelegates[i2] ) Then
    44                     isExist = True
     40        If Not ActiveBasic.IsNothing(dg) Then
     41            Dim i As Long
     42            For i=0 To ELM(This.simpleDelegates.Count)
     43                Dim i2 As Long
     44                Dim isExist = False
     45                For i2=0 To ELM(dg.simpleDelegates.Count)
     46                    If This.simpleDelegates[i].IsEqual( dg.simpleDelegates[i2] ) Then
     47                        isExist = True
     48                    End If
     49                Next
     50                If isExist Then
     51                    This.simpleDelegates.RemoveAt( i )
    4552                End If
    4653            Next
    47             If isExist Then
    48                 This.simpleDelegates.RemoveAt( i )
    49             End If
    50         Next
     54        End If
    5155    End Sub
    5256
Note: See TracChangeset for help on using the changeset viewer.