Changeset 637 for trunk


Ignore:
Timestamp:
Sep 29, 2008, 1:02:27 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

Button.OnClickの仕組みを汎用的（WM_COMMAND全般）に。WndProcなどをProtectedへ。

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

Legend:

Unmodified
Added
Removed

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

    r561 r637  
    1313*/
    1414Class Button
    15     Inherits Control
     15    Inherits WmCommandControl
    1616Protected
    1717    Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    … …  
    2626    End Sub
    2727
     28    Override Function RaiseCommandEvent(notificationCode As Word) As Boolean
     29        Dim lr As LRESULT
     30        RaiseCommandEvent = False
     31        Select Case notificationCode
     32            Case BN_CLICKED
     33                RaiseCommandEvent = OnClick(Args.Empty)
     34            Case BN_DBLCLK
     35                RaiseCommandEvent = OnDoubleClick(Args.Empty)
     36            Case BN_SETFOCUS
     37                RaiseCommandEvent = ProcessMessage(WM_SETFOCUS, 0, 0, lr)
     38            Case BN_KILLFOCUS
     39                RaiseCommandEvent = ProcessMessage(WM_KILLFOCUS, 0, 0, lr)
     40            'ここに挙げられなかったBNメッセージは、16ビットWindowsとの互換性のためとされているもの。
     41        End Select
     42    End Function
     43
    2844End Class
    2945

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

    r615 r637  
    138138        registerStandardEvent()
    139139        AssociateHWnd(hwndNew)
     140    End Sub
     141
     142    Sub BeginSubclass()
     143        throwIfNotCreated()
    140144        prevWndProc = SetWindowLongPtr(GWLP_WNDPROC, AddressOf(WndProcFirst) As LONG_PTR) As WNDPROC
    141145    End Sub
    … …  
    144148    Sub throwIfAlreadyCreated()
    145149        If hwnd <> 0 Then
    146             Throw New System.InvalidOperationException("Window already created.")
     150            Throw New System.InvalidOperationException("Window is already created.")
     151        End If
     152    End Sub
     153
     154    Sub throwIfNotCreated()
     155        If hwnd = 0 Then
     156            Throw New System.InvalidOperationException("Window is not already created.")
    147157        End If
    148158    End Sub
    … …  
    150160'--------------------------------
    151161' ウィンドウプロシージャ
    152 'Protected
    153 Public
     162
     163Protected
    154164    Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
     165        If Not ProcessMessage(msg, wp, lp, WndProc) Then
     166            WndProc = DefWndProc(msg, wp, lp)
     167        End If
     168    End Function
     169
     170    Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
     171        If prevWndProc Then
     172            DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
     173        Else
     174            DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
     175        End If
     176    End Function
     177Protected
     178    Function ProcessMessage(msg As DWord, wp As WPARAM, lp As LPARAM, ByRef lr As LRESULT) As Boolean
    155179        Dim h = Nothing As MessageHandler
    156180        Dim b = messageMap.TryGetValue(Hex$(msg), h)
    … …  
    160184                h(This, a)
    161185                If a.Handled Then
    162                     WndProc = a.LResult
     186                    lr = a.LResult
     187                    ProcessMessage = True
    163188                    Exit Function
    164189                End If
    165190            End If
    166191        End If
    167         WndProc = DefWndProc(msg, wp, lp)
    168     End Function
    169 
    170     Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    171         If prevWndProc Then
    172             DefWndProc = CallWindowProc(prevWndProc, hwnd, msg, wp, lp)
    173         Else
    174             DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
    175         End If
    176     End Function
    177 
     192        ProcessMessage = False
     193    End Function
    178194Private
    179195    Static Function makeKeysFormMsg(e As MessageArgs) As Keys
    … …  
    428444    */
    429445    Sub AssociateHWnd(hwndNew As HWND)
    430         hwnd = hwndNew
     446        SetHWnd(hwndNew)
    431447        Prop[PropertyInstance] = ObjPtr(This) As HANDLE
    432448        comImpl.AddRef()
    … …  
    513529    Static Sub Initialize(hinst As HINSTANCE)
    514530        tlsIndex = TlsAlloc()
     531        If tlsIndex = TLS_OUT_OF_INDEXES Then
     532            ThrowWithLastError("Control.Initialize: TlsAlloc failed.")
     533        End If
    515534        hInstance = hinst
    516535        hmodComctl = LoadLibrary("comctl32.dll")
    … …  
    519538        Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
    520539        PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString))
     540        If PropertyInstance = 0 Then
     541            ThrowWithLastError("Control.Initialize: GlobalAddAtom failed.")
     542        End If
    521543
    522544        Dim wcx As WNDCLASSEX
    … …  
    537559        atom = RegisterClassEx(wcx)
    538560        If atom = 0 Then
    539             Dim buf[1023] As TCHAR
    540             wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError())
    541             OutputDebugString(buf)
    542             Debug
    543             ExitThread(0)
     561            ThrowWithLastErrorNT("Control.Initialize: RegisterClasseEx failed.")
    544562        End If
    545563    End Sub
    … …  
    561579End Class
    562580
     581/*!
     582@brief WM_COMMANDで通知を行うコントロールの基底クラス
     583@date 2008/08/28
     584@auther Egtra
     585親がWM_COMMANDを受け取ったら、RaiseCommandEventを呼ぶことを意図している。
     586（Formで実装済み）
     587*/
     588Class WmCommandControl
     589    Inherits Control
     590Public
     591    Abstract Function RaiseCommandEvent(notificationCode As Word) As Boolean
     592End Class
     593
    563594End Namespace 'UI
    564595End Namespace 'Widnows

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

    r576 r637  
    88    Inherits Form
    99Public
    10 
    11     Override Function DefWndProc(m As DWord, w As WPARAM, l As LPARAM) As LRESULT
    12         DefWndProc = FALSE
    13     End Function
    14 
    1510    Function DoModal(hwndParent As HWND) As Long
    1611        Dim temp[31] As Byte
    … …  
    2015        StartWndProc()
    2116        DoModal = DialogBoxIndirectParam(Control.hInstance, temp As *DLGTEMPLATE, hwndParent, AddressOf(DefDlgProc), 0)
     17    End Function
     18Protected
     19    Override Function DefWndProc(m As DWord, w As WPARAM, l As LPARAM) As LRESULT
     20        DefWndProc = FALSE
    2221    End Function
    2322

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

    r561 r637  
    88/*!
    99@brief エディトコントロールのクラス
    10 @date 2007/07/21
     10@date 2008/07/21
    1111@auther Egtra
    1212*/
    1313Class EditBox
    14     Inherits Control
     14    Inherits WmCommandControl
    1515Protected
    1616    Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    … …  
    1919        End With
    2020    End Sub
     21Public
     22    Override Function RaiseCommandEvent(notificationCode As Word) As Boolean
     23        RaiseCommandEvent = False
     24    End Function
    2125
    2226    'ToDo: Lineなどを設ける

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

    r615 r637  
    3939
    4040    Sub OnCommand(sender As Object, e As MessageArgs)
    41         Dim id = e.WParam And &hffff 'LOWORD(e.WParam)
    42         Dim cmd = (e.WParam >> 16) And &hffff 'HIWORD(e.WParam)
     41'       Dim id = e.WParam And &hffff 'LOWORD(e.WParam)
     42        Dim cmd = ((e.WParam >> 16) And &hffff) As Word 'HIWORD(e.WParam)
    4343        Dim hwnd = e.LParam As HWND
    44         If cmd = BN_CLICKED And hwnd <> 0 Then
    45             Dim c = Control.FromHWnd(hwnd)
     44        If hwnd <> 0 Then
     45            Dim c = Control.FromHWnd(hwnd) As WmCommandControl
    4646            If IsNothing(c) = False Then
    47                 Dim b = c As Button
    48                 b.RaiseClick()
     47                c.RaiseCommandEvent(cmd)
    4948            End If
    5049        End If

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

    r615 r637  
    308308    End Function
    309309*/
    310     Function Move(x As Long, y As Long, width As Long, height As Long, repaint As Boolean) As Boolean
     310    Function Move(x As Long, y As Long, width As Long, height As Long, repaint = True As Boolean) As Boolean
    311311        Return MoveWindow(hwnd, x, y, width, height, repaint) As Boolean
    312312    End Function
    313313
    314     Function Move(x As Long, y As Long, width As Long, height As Long) As Boolean
    315         Return MoveWindow(hwnd, x, y, width, height, TRUE) As Boolean
    316     End Function
    317 
    318     Function Move(ByRef rc As RECT, repaint As Boolean) As Boolean
     314    Function Move(ByRef rc As RECT, repaint = True As Boolean) As Boolean
    319315        With rc
    320316            Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, repaint) As Boolean
    … …  
    322318    End Function
    323319
    324     Function Move(ByRef rc As RECT) As Boolean
    325         With rc
    326             Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, TRUE) As Boolean
    327         End With
    328     End Function
    329320/*
    330321    Function OpenClipboard() As Boolean
    … …  
    586577
    587578    Const Function Maximized() As Boolean
    588         Return IsIconic() As Boolean
     579        Return IsZoomed(hwnd) As Boolean
    589580    End Function
    590581
    … …  
    668659        sb.Length = size
    669660        Dim length = GetWindowText(hwnd, StrPtr(sb), size)
     661        sb.Length(length)
    670662        Text = sb.ToString
    671663    End Function
Note: See TracChangeset for help on using the changeset viewer.