Changeset 544


Ignore:
Timestamp:
Jul 13, 2008, 1:47:20 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

キー関連とCreateイベントの追加

Location:
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r542 r544  
    1414Class Control
    1515Public
    16 
    17 '1
    18 
    1916    Sub Control()
    2017    End Sub
    … …  
    4744
    4845'--------------------------------
    49 ' 1 ウィンドウ作成
     46' ウィンドウ作成
    5047/*
    5148    Function Create(
    … …  
    9087Public
    9188    Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    92 /*
    93         Select Case msg
    94             Case WM_MOUSELEAVE
    95                 OnMouseLeave(makeMouseEventFromWPLP(wp, lp))
    96                 mouseEntered = False
    97             Case WM_KEYDOWN
    98                 OnKeyDown(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
    99             Case WM_KEYUP
    100                 OnKeyUp(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
    101             Case WM_CHAR
    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
    109 */
    11089        Dim h = Nothing As MessageEventHandler
    11190        Dim b = messageMap.TryGetValue(Hex$(msg), h)
    … …  
    126105
    127106Private
    128     Static Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
     107    Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys
    129108        Dim t As DWord
    130         t = wp And Keys.KeyCode
     109        t = e.WParam And Keys.KeyCode
    131110        t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1
    132111        t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2
    133112        t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3
    134         makeKeysFormWPLP = t As Keys
    135     End Function
    136 
    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)
     113        makeKeysFormMsg = t As Keys
     114    End Function
     115
     116    Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs
     117        Dim wp = e.WParam
     118        Dim lp = e.LParam
     119        makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
    139120    End Function
    140121
    … …  
    146127    Sub StartWndProc()
    147128        Dim t = This '#177対策
    148         messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
    149129        AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
    150130        Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
    … …  
    163143        AddMessageEvent(WM_MBUTTONDBLCLK, mu)
    164144        AddMessageEvent(WM_XBUTTONDBLCLK, mu)
     145
     146        AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase))
    165147        AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
     148        AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase))
     149'       AddMessageEvent(WM_CHAR, AddressOf(t.OnChar))   
     150        AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase))
    166151    End Sub
    167152
    … …  
    174159
    175160    Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
    176         OnMouseDown(makeMouseEventFromWPLP(e.WParam, e.LParam))
     161        OnMouseDown(makeMouseEventFromMsg(e))
    177162    End Sub
    178163
    179164    Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
    180         Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     165        Dim me = makeMouseEventFromMsg(e)
    181166        If doubleClickFired = False Then
    182             OnClick(EventArgs.Empty)
     167'           OnClick(System.EventArgs.Empty)
    183168            OnMouseClick(me)
    184169            doubleClickFired = False
    … …  
    188173
    189174    Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
    190         Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     175        Dim me = makeMouseEventFromMsg(e)
    191176        doubleClickFired = True
    192177        OnMouseDown(me)
    193         OnDoubleClick(EventArgs.Empty)
     178'       OnDoubleClick(System.EventArgs.Empty)
    194179        OnMouseDoubleClick(me)
    195180    End Sub
    196181
    197182    Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
    198         Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
     183        Dim me = makeMouseEventFromMsg(e)
    199184        If mouseEntered Then
    200185            OnMouseMove(me)
    … …  
    205190    End Sub
    206191
     192    Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs)
     193        Dim me = makeMouseEventFromMsg(e)
     194        OnMouseLeave(me)
     195        mouseEntered = False
     196    End Sub
     197
    207198    Sub OnPaintBase(sender As Object, e As MessageEventArgs)
    208199        Dim ps As PAINTSTRUCT
    209200        BeginPaint(hwnd, ps)
    210 '       Try
    211 '           OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
    212 '       Finally
     201        Try
     202            OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
     203        Finally
    213204            EndPaint(hwnd, ps)
    214 '       End Try
    215     End Sub
    216 
     205        End Try
     206    End Sub
     207
     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
    217224
    218225    messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
    … …  
    260267'--------
    261268'イベント
    262 ' 3
    263269
    264270#include "ControlEvent.sbp"
    265271
    266272'--------------------------------
    267 ' 1 インスタンスメンバ変数
     273' インスタンスメンバ変数
    268274Private
    269275    hwnd As HWND
    … …  
    281287
    282288'--------------------------------
    283 ' 1 初期ウィンドウクラス
     289' 初期ウィンドウクラス
    284290Private
    285291    Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    … …  
    339345
    340346'--------------------------------
    341 ' 1 初期化終了関連（特にウィンドウクラス）
     347' 初期化終了関連（特にウィンドウクラス）
    342348Private
    343349    'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
    … …  
    450456    Inherits Form
    451457Public
    452     Sub NcDestory(sender As Object, et As EventArgs)
     458    Sub t()
     459        Dim f = This
     460        f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory))
     461        f.AddPaintDC(AddressOf (f.Paint))
     462    End Sub
     463
     464    Sub Destory(sender As Object, e As EventArgs)
     465        OutputDebugString(Ex"Destory\r\n")
    453466        PostQuitMessage(0)
    454467    End Sub
     468
     469    Sub Paint(sender As Object, e As PaintDCEventArgs)
     470        TextOut(e.Handle, 10, 10, "Hello world!", 12)
     471    End Sub
    455472End Class
    456473
    457474Dim f = New MyForm
     475f.t()
    458476f.Create()
    459 Dim h = New MessageEventHandler(AddressOf (f.NcDestory))
    460 f.AddMessageEvent(WM_NCDESTROY, h)
    461477ShowWindow(f.Handle, SW_SHOW)
    462478
    … …  
    481497
    482498End
    483 

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

    r542 r544  
    1 
    21Public
    32    Sub AddPaintDC(h As PaintDCEventHandler)
    … …  
    2322
    2423Public
    25     Sub AddClick(h As System.EventHandler)
    26         If IsNothing(click) Then
    27             click = h
    28         Else
    29             click += h
    30         End If
    31     End Sub
    32     Sub RemoveClick(h As System.EventHandler)
    33         If Not IsNothing(click) Then
    34             click -= h
    35         End If
    36     End Sub
    37 Private
    38     Sub OnClick(e As System.EventArgs)
    39         If Not IsNothing(click) Then
    40             click(This, e)
    41         End If
    42     End Sub
    43 Private
    44     click As System.EventHandler
    45 
    46 Public
    47     Sub AddDoubleClick(h As System.EventHandler)
    48         If IsNothing(doubleClick) Then
    49             doubleClick = h
    50         Else
    51             doubleClick += h
    52         End If
    53     End Sub
    54     Sub RemoveDoubleClick(h As System.EventHandler)
    55         If Not IsNothing(doubleClick) Then
    56             doubleClick -= h
    57         End If
    58     End Sub
    59 Private
    60     Sub OnDoubleClick(e As System.EventArgs)
    61         If Not IsNothing(doubleClick) Then
    62             doubleClick(This, e)
    63         End If
    64     End Sub
    65 Private
    66     doubleClick As System.EventHandler
    67 
    68 Public
    6924    Sub AddMouseEnter(h As MouseEventHandler)
    7025        If IsNothing(mouseEnter) Then
    … …  
    285240Private
    286241    keyUp As KeyEventHandler
    287 /*
    288 Public
    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
    301 Private
    302     Sub OnKeyPress(e As KeyPressEventArgs)
    303         If Not IsNothing(keyPress) Then
    304             keyPress(This, e)
    305         End If
    306     End Sub
    307 Private
    308     keyPress As KeyPressEventHandler
    309242
    310243Public
    … …  
    329262Private
    330263    create As CreateEventHandler
    331 */
     264

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

    r542 r544  
    11PaintDC PaintDCEvent    ウィンドウの描画が必要なときに呼び出されます。
    2 Click   Event   クリックされたときに呼び出されます。
    3 DoubleClick Event   ダブルクリックされたときに呼び出されます。
     2'Click  Event   クリックされたときに呼び出されます。
     3'DoubleClick    Event   ダブルクリックされたときに呼び出されます。
    44'EnableChanged  Event   有効状態が変化したときに呼び出されます。
    55'Move   Event   ウィンドウが移動したときに呼び出されます。

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

    r542 r544  
    491491Delegate Sub CreateEventHandler(sender As Object, e As CreateEventArgs)
    492492
     493Class FormClosingEventArgs
     494    Inherits EventArgs
     495Public
     496    Sub FormClosingEventArgs()
     497        c = False
     498    End Sub
     499
     500    Function Cancel() As Boolean
     501        Cancel = c
     502    End Function
     503
     504    Sub Cancel(cancel As Boolean)
     505        c = cancel
     506    End Sub
     507Private
     508    c As Boolean
     509End Class
     510
     511Delegate Sub FormClosingEventHandler(sender As Object, e As FormClosingEventArgs)
     512
    493513End Namespace 'Forms
    494514End Namespace 'UI
Note: See TracChangeset for help on using the changeset viewer.