Changeset 551 for trunk/ab5.0/ablib/src


Ignore:
Timestamp:
Jul 17, 2008, 11:20:10 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

Buttonの追加。WM_COMMANDから子のClickイベントを発生させる仕組みの追加など。

Location:
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI
Files:
3 added
1 deleted
9 edited

Legend:

Unmodified
Added
Removed

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

    r547 r551  
    5858
    5959Private
    60     Static Sub OnMainFormClosed(sender As Object, e As EventArgs)
     60    Static Sub OnMainFormClosed(sender As Object, e As Args)
    6161        ExitThread()
    6262    End Sub

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

    r547 r551  
    1414    Inherits WindowHandle
    1515Public
     16    /*!
     17    @brief Destroyイベントよりも後に呼ばれるDestroyイベントデリゲート
     18    @date   2008/07/16
     19    */
     20    finalDestroy As ActiveBasic.Windows.UI.Handler
    1621
    1722    Sub Control()
    … …  
    3439Private
    3540    Static Function FromHWndCore(hwnd As HWND) As Control
    36         If _System_GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
    37             Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
    38             If gchValue <> 0 Then
    39                 Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue)
    40                 FromHWndCore = gch.Target As Control
    41                 Exit Function
    42             End If
     41        Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
     42        If gchValue <> 0 Then
     43            Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue)
     44            FromHWndCore = gch.Target As Control
     45            Exit Function
    4346        End If
    4447    End Function
    … …  
    5558
    5659Public
    57     Sub Create()
     60    Sub Create(parent = Nothing As Control, style = 0 As DWord, exStyle = 0 As DWord, hmenu = 0 As HMENU)
    5861        Dim cs As CREATESTRUCT
    59         cs.hInstance = hInstance
    60         cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR
     62        With cs
     63            .dwExStyle = exStyle
     64            .lpszClass = (atom As ULONG_PTR) As LPCTSTR
     65            .lpszName = 0
     66            .style = style Or WS_CHILD Or WS_VISIBLE
     67            .x = CW_USEDEFAULT
     68            .y = CW_USEDEFAULT
     69            .cx = CW_USEDEFAULT
     70            .cy = CW_USEDEFAULT
     71            If IsNothing(parent) Then
     72                .hwndParent = 0
     73            Else
     74                .hwndParent = parent As HWND
     75                .style Or= WS_CHILD
     76            End If
     77            .hMenu = hmenu
     78            .hInstance = hInstance
     79        End With
    6180        GetCreateStruct(cs)
    62         createImpl(cs)
    63     End Sub
    64 
     81        createImpl(cs, parent)
     82    End Sub
     83
     84    Sub Create(parent As Control, style As DWord, exStyle As DWord, id As Long)
     85        Create(parent, style, exStyle, id As HMENU)
     86    End Sub
    6587Protected
    6688    Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    6789
    68     Sub createImpl(ByRef cs As CREATESTRUCT)
     90    Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
    6991        Imports System.Runtime.InteropServices
    7092
    … …  
    7597
    7698        With cs
    77             Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
     99            'よそのクラスの場合、WndProcFirst内のhwndの代入が行われないため、ここでも行っておく。
     100            hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
    78101                .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
    79102            If hwnd = 0 Then
    80103                ActiveBasic.Windows.ThrowByWindowsError(GetLastError())
    81104            End If
     105           
     106            If IsNothing(FromHWndCore(hwnd)) <> False Then
     107                AssociateHWnd(gch, hwnd)
     108                TlsSetValue(tlsIndex, 0)
     109            End If
    82110        End With
     111
     112        If IsNothing(parent) = False Then
     113            RegisterUnassociateHWnd(parent)
     114        End If
    83115    End Sub
    84116
    … …  
    88120Public
    89121    Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    90         Dim h = Nothing As MessageEventHandler
     122        Dim h = Nothing As MessageHandler
    91123        Dim b = messageMap.TryGetValue(Hex$(msg), h)
    92124        If b Then
    93125            If Not IsNothing(h) Then
    94                 Dim a = New MessageEventArgs(hwnd, msg, wp, lp)
     126                Dim a = New MessageArgs(hwnd, msg, wp, lp)
    95127                h(This, a)
    96128                WndProc = a.LResult
    … …  
    106138
    107139Private
    108     Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys
     140    Static Function makeKeysFormMsg(e As MessageArgs) As Keys
    109141        Dim t As DWord
    110142        t = e.WParam And Keys.KeyCode
    … …  
    115147    End Function
    116148
    117     Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs
     149    Static Function makeMouseEventFromMsg(e As MessageArgs) As MouseArgs
    118150        Dim wp = e.WParam
    119151        Dim lp = e.LParam
    120         makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
     152        makeMouseEventFromMsg = New MouseArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
    121153    End Function
    122154
    … …  
    128160    Sub StartWndProc()
    129161        AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground))
    130         Dim md = New MessageEventHandler(AddressOf(OnMouseDownBase))
     162        Dim md = New MessageHandler(AddressOf(OnMouseDownBase))
    131163        AddMessageEvent(WM_LBUTTONDOWN, md)
    132164        AddMessageEvent(WM_RBUTTONDOWN, md)
    133165        AddMessageEvent(WM_MBUTTONDOWN, md)
    134166        AddMessageEvent(WM_XBUTTONDOWN, md)
    135         Dim mu = New MessageEventHandler(AddressOf(OnMouseUpBase))
     167        Dim mu = New MessageHandler(AddressOf(OnMouseUpBase))
    136168        AddMessageEvent(WM_LBUTTONUP, mu)
    137169        AddMessageEvent(WM_RBUTTONUP, mu)
    138170        AddMessageEvent(WM_MBUTTONUP, mu)
    139171        AddMessageEvent(WM_XBUTTONUP, mu)
    140         Dim mb = New MessageEventHandler(AddressOf(OnMouseDblClkBase))
     172        Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase))
    141173        AddMessageEvent(WM_LBUTTONDBLCLK, mu)
    142174        AddMessageEvent(WM_RBUTTONDBLCLK, mu)
    … …  
    148180        AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
    149181        AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
    150 '       AddMessageEvent(WM_CHAR, AddressOf(OnChar))
     182        AddMessageEvent(WM_CHAR, AddressOf(OnChar))
    151183        AddMessageEvent(WM_CREATE, AddressOf(OnCreateBase))
    152184    End Sub
    153185
    154     Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
     186    Sub OnEraseBackground(sender As Object, e As MessageArgs)
    155187        Dim rc = ClientRect
    156188        FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
    … …  
    158190    End Sub
    159191
    160     Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
     192    Sub OnMouseDownBase(sender As Object, e As MessageArgs)
    161193        OnMouseDown(makeMouseEventFromMsg(e))
    162194    End Sub
    163195
    164     Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
     196    Sub OnMouseUpBase(sender As Object, e As MessageArgs)
    165197        Dim me = makeMouseEventFromMsg(e)
    166198        If doubleClickFired = False Then
    167 '           OnClick(System.EventArgs.Empty)
     199'           OnClick(System.Args.Empty)
    168200            OnMouseClick(me)
    169201            doubleClickFired = False
    … …  
    172204    End Sub
    173205
    174     Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
     206    Sub OnMouseDblClkBase(sender As Object, e As MessageArgs)
    175207        Dim me = makeMouseEventFromMsg(e)
    176208        doubleClickFired = True
    177209        OnMouseDown(me)
    178 '       OnDoubleClick(System.EventArgs.Empty)
     210'       OnDoubleClick(System.Args.Empty)
    179211        OnMouseDoubleClick(me)
    180212    End Sub
    181213
    182     Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
     214    Sub OnMouseMoveBase(sender As Object, e As MessageArgs)
    183215        Dim me = makeMouseEventFromMsg(e)
    184216        If mouseEntered Then
    … …  
    190222    End Sub
    191223
    192     Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs)
     224    Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
    193225        Dim me = makeMouseEventFromMsg(e)
    194226        OnMouseLeave(me)
    … …  
    196228    End Sub
    197229
    198     Sub OnPaintBase(sender As Object, e As MessageEventArgs)
     230    Sub OnPaintBase(sender As Object, e As MessageArgs)
    199231        Dim ps As PAINTSTRUCT
    200232        BeginPaint(ps)
    201233        Try
    202             OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
     234            OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
    203235        Finally
    204236            EndPaint(ps)
    … …  
    206238    End Sub
    207239
    208     Sub OnKeyDownBase(sender As Object, e As MessageEventArgs)
    209         OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e)))
    210     End Sub
    211 
    212     Sub OnKeyUpBase(sender As Object, e As MessageEventArgs)
    213         OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e)))
    214     End Sub
    215 
    216 '   コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと
    217 '   Sub OnChar(sender As Object, e As MessageEventArgs)
    218 '       OnKeyPress(New KeyPressEventArgs(e.WParam As Char))
    219 '   End Sub
    220 
    221     Sub OnCreateBase(sender As Object, e As MessageEventArgs)
    222         OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT))
    223     End Sub
    224 
    225     messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
     240    Sub OnKeyDownBase(sender As Object, e As MessageArgs)
     241        OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
     242    End Sub
     243
     244    Sub OnKeyUpBase(sender As Object, e As MessageArgs)
     245        OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
     246    End Sub
     247
     248    Sub OnChar(sender As Object, e As MessageArgs)
     249        OnKeyPress(New KeyPressArgs(e.WParam As Char))
     250    End Sub
     251
     252    Sub OnCreateBase(sender As Object, e As MessageArgs)
     253'       OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
     254    End Sub
     255
     256    messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageHandler>
    226257
    227258Public
    … …  
    230261    @date   2007/12/04
    231262    */
    232     Sub AddMessageEvent(message As DWord, h As MessageEventHandler)
     263    Sub AddMessageEvent(message As DWord, h As MessageHandler)
    233264        If Not IsNothing(h) Then
    234265            If IsNothing(messageMap) Then
    235                 messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
     266                messageMap = New System.Collections.Generic.Dictionary<Object, MessageHandler>
    236267            End If
    237268            Dim msg = Hex$(message)
    238             Dim m = Nothing As MessageEventHandler
     269            Dim m = Nothing As MessageHandler
    239270            If messageMap.TryGetValue(msg, m) Then
    240271                messageMap.Item[msg] = m + h
    … …  
    249280    @date   2007/12/04
    250281    */
    251     Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler)
     282    Sub RemoveMessageEvent(message As DWord, a As MessageHandler)
    252283        If Not IsNothing(a) Then
    253284            If Not IsNothing(messageMap) Then
    … …  
    302333            ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
    303334
    304             If IsNothing(rThis) Then
     335            If AssociateHWnd(gch, hwnd) = False Then
    305336                Goto *InstanceIsNotFound
    306337            End If
    307             rThis.hwnd = hwnd
    308             rThis.Prop[PropertyInstance] = gchValue As HANDLE
     338        End If
     339        If msg = WM_NCDESTROY Then
     340            rThis.UnassociateHWnd()
     341        End If
     342        If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
     343            Dim f = rThis.finalDestroy
     344            f(rThis, Args.Empty)
     345'           finalDestroy(This, Args.Empty)
    309346        End If
    310347        WndProcFirst = rThis.WndProc(msg, wp, lp)
    311         If msg = WM_NCDESTROY Then
    312             Dim gchValue = rThis.Prop(PropertyInstance) As ULONG_PTR
    313             If gchValue <> 0 Then
    314                 GCHandle.FromIntPtr(gchValue).Free()
    315             End If
    316         End If
    317 
    318348        Exit Function
    319349
    … …  
    322352        WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
    323353    End Function
     354
     355    /*!
     356    @brief  Controlインスタンスとウィンドウハンドルを結び付ける。
     357    @param[in] 結び付けられるControlインスタンスを格納したGCHandle
     358    @param[in] hwnd 結び付けるウィンドウハンドル
     359    @date   2008/07/16
     360    これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。
     361    */
     362    Static Function AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) As Boolean
     363        Imports System.Runtime.InteropServices
     364        Dim rThis = gch.Target As Control
     365        If IsNothing(rThis) Then
     366            Exit Function
     367        End If
     368        rThis.hwnd = hwnd
     369        rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE
     370    End Function
     371
     372    /*!
     373    @brief  オーナーの破棄時にこのControlインスタンスとウィンドウハンドルの結び付けを解除するよう登録する。
     374    @param[in] owner 結び付けの解除を連動させるControl
     375    @date   2008/07/16
     376    ownerのFinalDestoryでこのControlとHWNDとの結び付けを解除する。
     377    */
     378    Sub RegisterUnassociateHWnd(owner As Control)
     379        If IsNothing(owner) = False Then
     380            Dim e = New Handler(AddressOf(UnassociateHWndOnEvent))
     381            If IsNothing(finalDestroy) Then
     382                owner.finalDestroy = e
     383            Else
     384                owner.finalDestroy += e
     385            End If
     386        End If
     387    End Sub
     388
     389    Sub UnassociateHWndOnEvent(sender As Object, e As Args)
     390        UnassociateHWnd()
     391    End Sub
     392
     393    Sub UnassociateHWnd()
     394        Imports System.Runtime.InteropServices
     395        Dim gchValue = Prop(PropertyInstance) As ULONG_PTR
     396        If gchValue <> 0 Then
     397            GCHandle.FromIntPtr(gchValue).Free()
     398        End If
     399    End Sub
    324400
    325401'   Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord

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

    r545 r551  
    11Public
    2     Sub AddPaintDC(h As PaintDCEventHandler)
     2    Sub AddPaintDC(h As PaintDCHandler)
    33        If IsNothing(paintDC) Then
    44            paintDC = h
    … …  
    77        End If
    88    End Sub
    9     Sub RemovePaintDC(h As PaintDCEventHandler)
     9    Sub RemovePaintDC(h As PaintDCHandler)
    1010        If Not IsNothing(paintDC) Then
    1111            paintDC -= h
    1212        End If
    1313    End Sub
    14 Private
    15     Sub OnPaintDC(e As PaintDCEventArgs)
     14Protected
     15    Sub OnPaintDC(e As PaintDCArgs)
    1616        If Not IsNothing(paintDC) Then
    1717            paintDC(This, e)
    … …  
    1919    End Sub
    2020Private
    21     paintDC As PaintDCEventHandler
    22 
    23 Public
    24     Sub AddMouseEnter(h As MouseEventHandler)
     21    paintDC As PaintDCHandler
     22
     23Public
     24    Sub AddClick(h As Handler)
     25        If IsNothing(click) Then
     26            click = h
     27        Else
     28            click += h
     29        End If
     30    End Sub
     31    Sub RemoveClick(h As Handler)
     32        If Not IsNothing(click) Then
     33            click -= h
     34        End If
     35    End Sub
     36Protected
     37    Sub OnClick(e As Args)
     38        If Not IsNothing(click) Then
     39            click(This, e)
     40        End If
     41    End Sub
     42Private
     43    click As Handler
     44
     45Public
     46    Sub AddDoubleClick(h As Handler)
     47        If IsNothing(doubleClick) Then
     48            doubleClick = h
     49        Else
     50            doubleClick += h
     51        End If
     52    End Sub
     53    Sub RemoveDoubleClick(h As Handler)
     54        If Not IsNothing(doubleClick) Then
     55            doubleClick -= h
     56        End If
     57    End Sub
     58Protected
     59    Sub OnDoubleClick(e As Args)
     60        If Not IsNothing(doubleClick) Then
     61            doubleClick(This, e)
     62        End If
     63    End Sub
     64Private
     65    doubleClick As Handler
     66
     67Public
     68    Sub AddMove(h As Handler)
     69        If IsNothing(move) Then
     70            move = h
     71        Else
     72            move += h
     73        End If
     74    End Sub
     75    Sub RemoveMove(h As Handler)
     76        If Not IsNothing(move) Then
     77            move -= h
     78        End If
     79    End Sub
     80Protected
     81    Sub OnMove(e As Args)
     82        If Not IsNothing(move) Then
     83            move(This, e)
     84        End If
     85    End Sub
     86Private
     87    move As Handler
     88
     89Public
     90    Sub AddMouseEnter(h As MouseHandler)
    2591        If IsNothing(mouseEnter) Then
    2692            mouseEnter = h
    … …  
    2995        End If
    3096    End Sub
    31     Sub RemoveMouseEnter(h As MouseEventHandler)
     97    Sub RemoveMouseEnter(h As MouseHandler)
    3298        If Not IsNothing(mouseEnter) Then
    3399            mouseEnter -= h
    34100        End If
    35101    End Sub
    36 Private
    37     Sub OnMouseEnter(e As MouseEventArgs)
     102Protected
     103    Sub OnMouseEnter(e As MouseArgs)
    38104        If Not IsNothing(mouseEnter) Then
    39105            mouseEnter(This, e)
    … …  
    41107    End Sub
    42108Private
    43     mouseEnter As MouseEventHandler
    44 
    45 Public
    46     Sub AddMouseMove(h As MouseEventHandler)
     109    mouseEnter As MouseHandler
     110
     111Public
     112    Sub AddMouseMove(h As MouseHandler)
    47113        If IsNothing(mouseMove) Then
    48114            mouseMove = h
    … …  
    51117        End If
    52118    End Sub
    53     Sub RemoveMouseMove(h As MouseEventHandler)
     119    Sub RemoveMouseMove(h As MouseHandler)
    54120        If Not IsNothing(mouseMove) Then
    55121            mouseMove -= h
    56122        End If
    57123    End Sub
    58 Private
    59     Sub OnMouseMove(e As MouseEventArgs)
     124Protected
     125    Sub OnMouseMove(e As MouseArgs)
    60126        If Not IsNothing(mouseMove) Then
    61127            mouseMove(This, e)
    … …  
    63129    End Sub
    64130Private
    65     mouseMove As MouseEventHandler
    66 
    67 Public
    68     Sub AddMouseHover(h As MouseEventHandler)
     131    mouseMove As MouseHandler
     132
     133Public
     134    Sub AddMouseHover(h As MouseHandler)
    69135        If IsNothing(mouseHover) Then
    70136            mouseHover = h
    … …  
    73139        End If
    74140    End Sub
    75     Sub RemoveMouseHover(h As MouseEventHandler)
     141    Sub RemoveMouseHover(h As MouseHandler)
    76142        If Not IsNothing(mouseHover) Then
    77143            mouseHover -= h
    78144        End If
    79145    End Sub
    80 Private
    81     Sub OnMouseHover(e As MouseEventArgs)
     146Protected
     147    Sub OnMouseHover(e As MouseArgs)
    82148        If Not IsNothing(mouseHover) Then
    83149            mouseHover(This, e)
    … …  
    85151    End Sub
    86152Private
    87     mouseHover As MouseEventHandler
    88 
    89 Public
    90     Sub AddMouseLeave(h As MouseEventHandler)
     153    mouseHover As MouseHandler
     154
     155Public
     156    Sub AddMouseLeave(h As MouseHandler)
    91157        If IsNothing(mouseLeave) Then
    92158            mouseLeave = h
    … …  
    95161        End If
    96162    End Sub
    97     Sub RemoveMouseLeave(h As MouseEventHandler)
     163    Sub RemoveMouseLeave(h As MouseHandler)
    98164        If Not IsNothing(mouseLeave) Then
    99165            mouseLeave -= h
    100166        End If
    101167    End Sub
    102 Private
    103     Sub OnMouseLeave(e As MouseEventArgs)
     168Protected
     169    Sub OnMouseLeave(e As MouseArgs)
    104170        If Not IsNothing(mouseLeave) Then
    105171            mouseLeave(This, e)
    … …  
    107173    End Sub
    108174Private
    109     mouseLeave As MouseEventHandler
    110 
    111 Public
    112     Sub AddMouseDown(h As MouseEventHandler)
     175    mouseLeave As MouseHandler
     176
     177Public
     178    Sub AddMouseDown(h As MouseHandler)
    113179        If IsNothing(mouseDown) Then
    114180            mouseDown = h
    … …  
    117183        End If
    118184    End Sub
    119     Sub RemoveMouseDown(h As MouseEventHandler)
     185    Sub RemoveMouseDown(h As MouseHandler)
    120186        If Not IsNothing(mouseDown) Then
    121187            mouseDown -= h
    122188        End If
    123189    End Sub
    124 Private
    125     Sub OnMouseDown(e As MouseEventArgs)
     190Protected
     191    Sub OnMouseDown(e As MouseArgs)
    126192        If Not IsNothing(mouseDown) Then
    127193            mouseDown(This, e)
    … …  
    129195    End Sub
    130196Private
    131     mouseDown As MouseEventHandler
    132 
    133 Public
    134     Sub AddMouseClick(h As MouseEventHandler)
     197    mouseDown As MouseHandler
     198
     199Public
     200    Sub AddMouseClick(h As MouseHandler)
    135201        If IsNothing(mouseClick) Then
    136202            mouseClick = h
    … …  
    139205        End If
    140206    End Sub
    141     Sub RemoveMouseClick(h As MouseEventHandler)
     207    Sub RemoveMouseClick(h As MouseHandler)
    142208        If Not IsNothing(mouseClick) Then
    143209            mouseClick -= h
    144210        End If
    145211    End Sub
    146 Private
    147     Sub OnMouseClick(e As MouseEventArgs)
     212Protected
     213    Sub OnMouseClick(e As MouseArgs)
    148214        If Not IsNothing(mouseClick) Then
    149215            mouseClick(This, e)
    … …  
    151217    End Sub
    152218Private
    153     mouseClick As MouseEventHandler
    154 
    155 Public
    156     Sub AddMouseDoubleClick(h As MouseEventHandler)
     219    mouseClick As MouseHandler
     220
     221Public
     222    Sub AddMouseDoubleClick(h As MouseHandler)
    157223        If IsNothing(mouseDoubleClick) Then
    158224            mouseDoubleClick = h
    … …  
    161227        End If
    162228    End Sub
    163     Sub RemoveMouseDoubleClick(h As MouseEventHandler)
     229    Sub RemoveMouseDoubleClick(h As MouseHandler)
    164230        If Not IsNothing(mouseDoubleClick) Then
    165231            mouseDoubleClick -= h
    166232        End If
    167233    End Sub
    168 Private
    169     Sub OnMouseDoubleClick(e As MouseEventArgs)
     234Protected
     235    Sub OnMouseDoubleClick(e As MouseArgs)
    170236        If Not IsNothing(mouseDoubleClick) Then
    171237            mouseDoubleClick(This, e)
    … …  
    173239    End Sub
    174240Private
    175     mouseDoubleClick As MouseEventHandler
    176 
    177 Public
    178     Sub AddMouseUp(h As MouseEventHandler)
     241    mouseDoubleClick As MouseHandler
     242
     243Public
     244    Sub AddMouseUp(h As MouseHandler)
    179245        If IsNothing(mouseUp) Then
    180246            mouseUp = h
    … …  
    183249        End If
    184250    End Sub
    185     Sub RemoveMouseUp(h As MouseEventHandler)
     251    Sub RemoveMouseUp(h As MouseHandler)
    186252        If Not IsNothing(mouseUp) Then
    187253            mouseUp -= h
    188254        End If
    189255    End Sub
    190 Private
    191     Sub OnMouseUp(e As MouseEventArgs)
     256Protected
     257    Sub OnMouseUp(e As MouseArgs)
    192258        If Not IsNothing(mouseUp) Then
    193259            mouseUp(This, e)
    … …  
    195261    End Sub
    196262Private
    197     mouseUp As MouseEventHandler
    198 
    199 Public
    200     Sub AddKeyDown(h As KeyEventHandler)
     263    mouseUp As MouseHandler
     264
     265Public
     266    Sub AddKeyDown(h As KeyHandler)
    201267        If IsNothing(keyDown) Then
    202268            keyDown = h
    … …  
    205271        End If
    206272    End Sub
    207     Sub RemoveKeyDown(h As KeyEventHandler)
     273    Sub RemoveKeyDown(h As KeyHandler)
    208274        If Not IsNothing(keyDown) Then
    209275            keyDown -= h
    210276        End If
    211277    End Sub
    212 Private
    213     Sub OnKeyDown(e As KeyEventArgs)
     278Protected
     279    Sub OnKeyDown(e As KeyArgs)
    214280        If Not IsNothing(keyDown) Then
    215281            keyDown(This, e)
    … …  
    217283    End Sub
    218284Private
    219     keyDown As KeyEventHandler
    220 
    221 Public
    222     Sub AddKeyUp(h As KeyEventHandler)
     285    keyDown As KeyHandler
     286
     287Public
     288    Sub AddKeyUp(h As KeyHandler)
    223289        If IsNothing(keyUp) Then
    224290            keyUp = h
    … …  
    227293        End If
    228294    End Sub
    229     Sub RemoveKeyUp(h As KeyEventHandler)
     295    Sub RemoveKeyUp(h As KeyHandler)
    230296        If Not IsNothing(keyUp) Then
    231297            keyUp -= h
    232298        End If
    233299    End Sub
    234 Private
    235     Sub OnKeyUp(e As KeyEventArgs)
     300Protected
     301    Sub OnKeyUp(e As KeyArgs)
    236302        If Not IsNothing(keyUp) Then
    237303            keyUp(This, e)
    … …  
    239305    End Sub
    240306Private
    241     keyUp As KeyEventHandler
    242 
    243 Public
    244     Sub AddCreate(h As CreateEventHandler)
     307    keyUp As KeyHandler
     308
     309Public
     310    Sub AddKeyPress(h As KeyPressHandler)
     311        If IsNothing(keyPress) Then
     312            keyPress = h
     313        Else
     314            keyPress += h
     315        End If
     316    End Sub
     317    Sub RemoveKeyPress(h As KeyPressHandler)
     318        If Not IsNothing(keyPress) Then
     319            keyPress -= h
     320        End If
     321    End Sub
     322Protected
     323    Sub OnKeyPress(e As KeyPressArgs)
     324        If Not IsNothing(keyPress) Then
     325            keyPress(This, e)
     326        End If
     327    End Sub
     328Private
     329    keyPress As KeyPressHandler
     330/*
     331Public
     332    Sub AddCreate(h As CreateHandler)
    245333        If IsNothing(create) Then
    246334            create = h
    … …  
    249337        End If
    250338    End Sub
    251     Sub RemoveCreate(h As CreateEventHandler)
     339    Sub RemoveCreate(h As CreateHandler)
    252340        If Not IsNothing(create) Then
    253341            create -= h
    254342        End If
    255343    End Sub
    256 Private
    257     Sub OnCreate(e As CreateEventArgs)
     344Protected
     345    Sub OnCreate(e As CreateArgs)
    258346        If Not IsNothing(create) Then
    259347            create(This, e)
    … …  
    261349    End Sub
    262350Private
    263     create As CreateEventHandler
    264 
     351    create As CreateHandler
     352
     353Public
     354    Sub AddDestroy(h As Handler)
     355        If IsNothing(destroy) Then
     356            destroy = h
     357        Else
     358            destroy += h
     359        End If
     360    End Sub
     361    Sub RemoveDestroy(h As Handler)
     362        If Not IsNothing(destroy) Then
     363            destroy -= h
     364        End If
     365    End Sub
     366Protected
     367    Sub OnDestroy(e As Args)
     368        If Not IsNothing(destroy) Then
     369            destroy(This, e)
     370        End If
     371    End Sub
     372Private
     373    destroy As Handler
     374*/

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

    r545 r551  
    1 PaintDC PaintDCEvent    ウィンドウの描画が必要なときに呼び出されます。
    2 'Click  Event   クリックされたときに呼び出されます。
    3 'DoubleClick    Event   ダブルクリックされたときに呼び出されます。
    4 'EnableChanged  Event   有効状態が変化したときに呼び出されます。
    5 'Move   Event   ウィンドウが移動したときに呼び出されます。
    6 'Resize Event   ウィンドウの大きさが変化したときに呼び出されます。
    7 'VisibleChanged Event   ウィンドウの表示状態が変化したときに呼び出されます。
    8 'SetFocus   Event   フォーカスを得たときに呼び出されます。
    9 'KillFocus  Event   フォーカスを失ったときに呼び出されます。
    10 MouseEnter  MouseEvent  マウスカーソルがコントロールに入ってくると呼び出されます。
    11 MouseMove   MouseEvent  マウスカーソルがコントロール上で移動すると呼び出されます
    12 MouseHover  MouseEvent  マウスカーソルがコントロール上で静止すると呼び出されます。
    13 MouseLeave  MouseEvent  マウスカーソルがコントロールから出て行くと呼び出されます。
    14 MouseDown   MouseEvent  マウスボタンが押されたときに呼び出されます。
    15 MouseClick  MouseEvent  マウスでクリックされたときに呼び出されます。
    16 MouseDoubleClick    MouseEvent  マウスでダブルクリックされたときに呼び出されます。
    17 MouseUp MouseEvent  マウスボタンが離されたときに呼び出されます。
    18 'MouseWheel MouseEvent  マウスホイールが回されたときに呼び出されます。
    19 KeyDown KeyEvent    キーが押されたときに呼ばれます。
    20 KeyUp   KeyEvent    キーが離されたときに呼ばれます。
    21 'なぜかコンパイルエラーを起こすのでコメントアウト KeyPress  KeyPressEvent   キーが押されて文字が打たれたときに呼ばれます。
    22 Create  CreateEvent ウィンドウが作成されたときに呼ばれます。
    23 'Destroy    Event   ウィンドウが破棄されるときに呼ばれます。
     1PaintDC PaintDC ウィンドウの描画が必要なときに呼び出されます。
     2Click       クリックされたときに呼び出されます。
     3DoubleClick     ダブルクリックされたときに呼び出されます。
     4'EnableChanged      有効状態が変化したときに呼び出されます。
     5Move        ウィンドウが移動したときに呼び出されます。
     6'Resize     ウィンドウの大きさが変化したときに呼び出されます。
     7'VisibleChanged     ウィンドウの表示状態が変化したときに呼び出されます。
     8'SetFocus       フォーカスを得たときに呼び出されます。
     9'KillFocus      フォーカスを失ったときに呼び出されます。
     10MouseEnter  Mouse   マウスカーソルがコントロールに入ってくると呼び出されます。
     11MouseMove   Mouse   マウスカーソルがコントロール上で移動すると呼び出されます
     12MouseHover  Mouse   マウスカーソルがコントロール上で静止すると呼び出されます。
     13MouseLeave  Mouse   マウスカーソルがコントロールから出て行くと呼び出されます。
     14MouseDown   Mouse   マウスボタンが押されたときに呼び出されます。
     15MouseClick  Mouse   マウスでクリックされたときに呼び出されます。
     16MouseDoubleClick    Mouse   マウスでダブルクリックされたときに呼び出されます。
     17MouseUp Mouse   マウスボタンが離されたときに呼び出されます。
     18'MouseWheel Mouse   マウスホイールが回されたときに呼び出されます。
     19KeyDown Key キーが押されたときに呼ばれます。
     20KeyUp   Key キーが離されたときに呼ばれます。
     21KeyPress    KeyPress    キーが押されて文字が打たれたときに呼ばれます。
     22Create  Create  ウィンドウが作成されたときに呼ばれます。
     23Destroy     ウィンドウが破棄されるときに呼ばれます。

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

    r547 r551  
    11/**
    2 @file Include/Classes/ActiveBasic/Windows/UI/EventArgs.ab
     2@file Include/Classes/ActiveBasic/Windows/UI/Args.ab
    33@brief イベントハンドラ関連
    44*/
    … …  
    88Namespace UI
    99
    10 'TypeDef EventArgs = System.EventArgs
    11 'TypeDef EventHandler = System.EventHandler
    12 Class EventArgs
    13 Public
    14     Static Empty = Nothing As EventArgs
    15 End Class
    16 Delegate Sub EventHandler(sender As Object, e As EventArgs)
    17 
    18 Class MessageEventArgs
    19     Inherits EventArgs
    20 Public
    21     Sub MessageEventArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM)
     10TypeDef Args = System.EventArgs
     11'TypeDef Handler = System.EventHandler
     12Delegate Sub Handler(sender As Object, e As Args)
     13
     14Class MessageArgs
     15    Inherits Args
     16Public
     17    Sub MessageArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM)
    2218        msg = message
    2319'       hwnd = hwndSrc
    … …  
    5854End Class
    5955
    60 Delegate Sub MessageEventHandler(sender As Object, e As MessageEventArgs)
    61 
    62 Class PaintDCEventArgs
    63     Inherits EventArgs
    64 Public
    65     Sub PaintDCEventArgs(hdcTarget As HDC, ByRef rect As RECT)
     56Delegate Sub MessageHandler(sender As Object, e As MessageArgs)
     57
     58Class PaintDCArgs
     59    Inherits Args
     60Public
     61    Sub PaintDCArgs(hdcTarget As HDC, ByRef rect As RECT)
    6662        hdc = hdcTarget
    6763        rc = rect
    … …  
    8177End Class
    8278
    83 Delegate Sub PaintDCEventHandler(sender As Object, e As PaintDCEventArgs)
    84 
    85 Class PaintDCHandledEventArgs
    86     Inherits PaintDCEventArgs
    87 Public
    88     Sub PaintDCHandledEventArgs(hdcTarget As HDC, ByRef rect As RECT)
    89         PaintDCEventArgs(hdcTarget, rect)
     79Delegate Sub PaintDCHandler(sender As Object, e As PaintDCArgs)
     80
     81Class PaintDCHandledArgs
     82    Inherits PaintDCArgs
     83Public
     84    Sub PaintDCHandledArgs(hdcTarget As HDC, ByRef rect As RECT)
     85        PaintDCArgs(hdcTarget, rect)
    9086    End Sub
    9187
    … …  
    10298End Class
    10399
    104 TypeDef PaintDCBackGroundEventArgs = PaintDCHandledEventArgs
     100TypeDef PaintDCBackGroundArgs = PaintDCHandledArgs
    105101
    106102Enum MouseButtons
    … …  
    116112End Enum
    117113
    118 Class MouseEventArgs
    119     Inherits EventArgs
    120 Public
    121     Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long)
     114Class MouseArgs
     115    Inherits Args
     116Public
     117    Sub MouseArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long)
    122118        This.button = button
    123119        This.clicks = clicks
    124120        This.pt = New System.Drawing.Point(x, y)
    125         OutputDebugString(ToTCStr(Hex$(y) + " " + Hex$(pt.Y) + " " +  Ex" mea\r\n"))
    126121        This.delta = delta
    127122    End Sub
    … …  
    158153End Class
    159154
    160 Delegate Sub MouseEventHandler(sender As Object, e As MouseEventArgs)
    161 
    162 Class KeyPressEventArgs
    163     Inherits EventArgs
    164 Public
    165     Sub KeyPressEventArgs(keyChar As Char)
     155Delegate Sub MouseHandler(sender As Object, e As MouseArgs)
     156
     157Class KeyPressArgs
     158    Inherits Args
     159Public
     160    Sub KeyPressArgs(keyChar As Char)
    166161        key = keyChar
    167162    End Sub
    … …  
    187182End Class
    188183
    189 Delegate Sub KeyPressEventHandler(sender As Object, e As KeyPressEventArgs)
     184Delegate Sub KeyPressHandler(sender As Object, e As KeyPressArgs)
    190185
    191186Enum Keys
    … …  
    384379End Enum
    385380
    386 Class KeyEventArgs
    387     Inherits EventArgs
    388 Public
    389     Sub KeyEventArgs(keyData As Keys)
     381Class KeyArgs
     382    Inherits Args
     383Public
     384    Sub KeyArgs(keyData As Keys)
    390385        key = keyData
    391386    End Sub
    … …  
    436431End Class
    437432
    438 Delegate Sub KeyEventHandler(sender As Object, e As KeyEventArgs)
    439 
    440 Class CreateEventArgs
    441     Inherits EventArgs
    442 Public
    443     Sub CreateEventArgs(pCreateStruct As *CREATESTRUCT)
     433Delegate Sub KeyHandler(sender As Object, e As KeyArgs)
     434
     435Class CreateArgs
     436    Inherits Args
     437Public
     438    Sub CreateArgs(pCreateStruct As *CREATESTRUCT)
    444439        pcs = pCreateStruct
    445440    End Sub
    … …  
    494489End Class
    495490
    496 Delegate Sub CreateEventHandler(sender As Object, e As CreateEventArgs)
    497 
    498 Class FormClosingEventArgs
    499     Inherits EventArgs
    500 Public
    501     Sub FormClosingEventArgs()
     491Delegate Sub CreateHandler(sender As Object, e As CreateArgs)
     492
     493Class FormClosingArgs
     494    Inherits Args
     495Public
     496    Sub FormClosingArgs()
    502497        c = False
    503498    End Sub
    … …  
    514509End Class
    515510
    516 Delegate Sub FormClosingEventHandler(sender As Object, e As FormClosingEventArgs)
     511Delegate Sub FormClosingHandler(sender As Object, e As FormClosingArgs)
    517512
    518513End Namespace 'UI

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

    r547 r551  
    22
    33#require <Classes/ActiveBasic/Windows/UI/Control.ab>
     4#require <Classes/ActiveBasic/Windows/UI/Button.ab>
    45
    56Namespace ActiveBasic
    … …  
    1213@author Egtra
    1314*/
     15
    1416Class Form
    1517    Inherits Control
     18Public
     19    Sub Form()
     20        AddMessageEvent(WM_COMMAND, AddressOf (OnCommand))
     21    End Sub
     22
    1623Protected
    1724    Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    18         With cs
    19             .lpCreateParams = 0
    20             '.hInstance
    21             .hMenu = 0
    22             .hwndParent = 0
    23             .cy = CW_USEDEFAULT
    24             .cx = CW_USEDEFAULT
    25             .y = CW_USEDEFAULT
    26             .x = CW_USEDEFAULT
    27             .style = WS_OVERLAPPEDWINDOW
    28             .lpszName = ""
    29             '.lpszClass
    30             .dwExStyle = 0
    31         End With
     25        cs.style = WS_OVERLAPPEDWINDOW
    3226    End Sub
     27
     28    Sub OnCommand(sender As Object, e As MessageArgs)
     29        Dim id = e.WParam And &hffff 'LOWORD(e.WParam)
     30        Dim cmd = (e.WParam >> 16) And &hffff 'HIWORD(e.WParam)
     31        Dim hwnd = e.LParam As HWND
     32        If cmd = BN_CLICKED And hwnd <> 0 Then
     33            Dim c = Control.FromHWnd(hwnd)
     34            If IsNothing(c) = False Then
     35                Dim b = c As Button
     36                b.RaiseClick()
     37            End If
     38        End If
     39    End Sub
     40
    3341#include "FormEvent.sbp"
    3442End Class
    … …  
    4250
    4351#require <Classes/ActiveBasic/Windows/UI/Application.ab>
     52#require <Classes/ActiveBasic/Windows/UI/Button.ab>
    4453
    4554Imports ActiveBasic.Windows.UI
    … …  
    4857Control.Initialize(GetModuleHandle(0))
    4958
     59Sub Paint(sender As Object, e As PaintDCArgs)
     60    TextOut(e.Handle, 10, 10, "Hello world!", 12)
     61End Sub
     62
    5063Class MyForm
    5164    Inherits Form
    5265Public
    5366    Sub MyForm()
    54         Dim f = This
    55         AddMessageEvent(WM_DESTROY, AddressOf (f.Destory))
    56         AddPaintDC(AddressOf (f.Paint))
    57         AddMouseClick(AddressOf (f.Mouse))
    58         s = ""
     67        AddPaintDC(AddressOf (Paint))
     68        AddMouseClick(AddressOf (Mouse))
     69        s = "aaa"
    5970    End Sub
    6071
    61     Sub Destory(sender As Object, e As EventArgs)
    62         OutputDebugString(Ex"Destory\r\n")
    63         PostQuitMessage(0)
     72'   Sub Paint(sender As Object, e As PaintDCArgs)
     73'       TextOut(e.Handle, 10, 10, ToTCStr(s), s.Length)
     74'   End Sub
     75
     76    Sub Mouse(sender As Object, e As MouseArgs)
     77        Invalidate()
    6478    End Sub
    6579
    66     Sub Paint(sender As Object, e As PaintDCEventArgs)
    67         TextOut(e.Handle, 10, 10, ToTCStr(s), s.Length)
    68     End Sub
    69 
    70     Sub Mouse(sender As Object, e As MouseEventArgs)
    71         Dim sb = New System.Text.StringBuilder
    72         sb.Append("X = ").Append(e.X).Append(", Y = ").Append(e.Y)
    73         s = sb.ToString
    74         OutputDebugString(ToTCStr(s + " " + Hex$(ObjPtr(e)) + Ex"\r\n"))
    75         Invalidate()
     80    Sub OnClick(sender As Object, e As Args)
     81        OutputDebugString(Ex"====OnClick====\r\n")
    7682    End Sub
    7783
    … …  
    8187Dim f = New MyForm
    8288f.Create()
     89f.Text = "Hello"
     90
     91Dim b = New Button
     92b.Create(f)
     93b.Move(50, 50, 100, 100)
     94b.Text = "Ok"
     95b.AddClick(AddressOf(f.OnClick))
     96
    8397Application.Run(f)
    8498f = Nothing
    … …  
    89103
    90104End
    91 

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

    r545 r551  
    11Public
    2     Sub AddQueryClose(h As FormClosingEventHandler)
     2    Sub AddQueryClose(h As FormClosingHandler)
    33        If IsNothing(queryClose) Then
    44            queryClose = h
    … …  
    77        End If
    88    End Sub
    9     Sub RemoveQueryClose(h As FormClosingEventHandler)
     9    Sub RemoveQueryClose(h As FormClosingHandler)
    1010        If Not IsNothing(queryClose) Then
    1111            queryClose -= h
    1212        End If
    1313    End Sub
    14 Private
    15     Sub OnQueryClose(e As FormClosingEventArgs)
     14Protected
     15    Sub OnQueryClose(e As FormClosingArgs)
    1616        If Not IsNothing(queryClose) Then
    1717            queryClose(This, e)
    … …  
    1919    End Sub
    2020Private
    21     queryClose As FormClosingEventHandler
     21    queryClose As FormClosingHandler
    2222

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

    r547 r551  
    44'f  QueryClose  WM_CLOSE
    55'f  Timer   WM_TIMER
    6 'Activate   Event   ウィンドウがアクティブになったときに呼ばれます。
    7 'Deactivate Event   ウィンドウがアクティブでなくなったときに呼ばれます。
    8 QueryClose  FormClosingEvent    ウィンドウが閉じられようとしているときに呼ばれます。
     6'Activate       ウィンドウがアクティブになったときに呼ばれます。
     7'Deactivate     ウィンドウがアクティブでなくなったときに呼ばれます。
     8QueryClose  FormClosing ウィンドウが閉じられようとしているときに呼ばれます。

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

    r545 r551  
    4040    out.WriteLine(Ex"\t\tEnd If")
    4141    out.WriteLine(Ex"\tEnd Sub")
    42     out.WriteLine("Private")
     42    out.WriteLine("Protected")
    4343'   out.WriteLine(Ex"\t/*!")
    4444'   out.WriteLine(Ex"\t@brief " & comment)
    … …  
    7979MakeControlEvent("Control")
    8080MakeControlEvent("Form")
     81MakeControlEvent("Application")
    8182End
Note: See TracChangeset for help on using the changeset viewer.