Changeset 575


Ignore:
Timestamp:
Aug 3, 2008, 3:58:05 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

ウィンドウ作成関数を親用のCreateFormと子用のCreateに分離。

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

Legend:

Unmodified
Added
Removed

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

    r561 r575  
    2222    Sub MyForm()
    2323        AddResize(AddressOf(OnResize))
    24         Create()
     24        CreateForm()
    2525        myEdit = New EditBox
    26         myEdit.Create(This, ES_MULTILINE Or ES_WANTRETURN Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or WS_HSCROLL Or WS_VSCROLL, WS_EX_CLIENTEDGE)
    27         myEdit.SendMessage(WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT) As WPARAM, 0)
     26        With myEdit
     27            .Create(This, ES_MULTILINE Or ES_WANTRETURN Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or WS_HSCROLL Or WS_VSCROLL, WS_EX_CLIENTEDGE)
     28            .SendMessage(WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT) As WPARAM, 0)
     29        End With
    2830        Show(SW_SHOWDEFAULT)
    2931    End Sub

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

    r561 r575  
    6262
    6363    Sub ButtonTime_Click(sender As Object, e As Args)
    64         TaskMsg(This, "今日の日付", DateTime.Now.GetDateTimeFormats("H:mm:ss"), Nothing, MB_OK)
     64        TaskMsg(This, "現在時刻", DateTime.Now.GetDateTimeFormats("H:mm:ss"), Nothing, MB_OK)
    6565    End Sub
    6666
    … …  
    7171Control.Initialize(GetModuleHandle(0))
    7272Dim f = New DayTimeCheckForm
    73 f.Create()
     73f.CreateForm()
    7474Application.Run(f)

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

    r559 r575  
    11'Classes/ActiveBasic/Windows/UI/Application.ab
     2
     3#require <Classes/ActiveBasic/Windows/UI/Form.ab>
    24
    35Namespace ActiveBasic
    46Namespace Windows
    57Namespace UI
     8
     9Delegate Function MessageFilter(m As *MSG) As Boolean
    610
    711/*!
    … …  
    2327            form.Show(SW_SHOW)
    2428            form.Update()
    25             form.AddMessageEvent(WM_DESTROY, AddressOf(Application.OnMainFormClosed))
     29            form.AddMessageEvent(WM_DESTROY, AddressOf(OnMainFormClosed))
    2630        End If
    2731
    … …  
    3236                Exit Do
    3337            End If
    34             TranslateMessage(m)
    35             DispatchMessage(m)
     38            dispatchMessage(m)
    3639        Loop
    3740
    … …  
    7073                    PostQuitMessage(0) 'Run()で捕まえてくれるようPostしなおす。
    7174                Case Else
    72                     TranslateMessage(msg)
    73                     DispatchMessage(msg)
     75                    dispatchMessage(msg)
    7476            End Select
    7577        Wend
    7678    End Sub
     79/*
     80    Static Sub AddMessageFilter(mf As MessageFilter)
     81        If IsNothing(filter) Then
     82            filter = New System.Collections.Generic.List<MessageFilter>
     83        End If
     84        filter.Add(mf)
     85    End Sub
    7786
     87    Static Sub RemoveMessageFilter(mf As MessageFilter)
     88        filter.Remove(mf)
     89    End Sub
     90*/
    7891#include "ApplicationEvent.sbp"
    7992
    … …  
    8396        ExitThread()
    8497    End Sub
     98
     99    Static Sub dispatchMessage(ByRef m As MSG)
     100/*      If IsNothing(filter) = False Then
     101            For Each f In filter
     102            Next
     103        End If
     104*/      TranslateMessage(m)
     105        DispatchMessage(m)
     106    End Sub
     107
     108'   Static filter As System.Collections.Generic.List<MessageFilter>
    85109End Class
    86110

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

    r564 r575  
    22
    33#require <Classes/ActiveBasic/Windows/UI/EventArgs.ab>
     4#require <Classes/ActiveBasic/COM/ComClassBase.ab>
    45
    56Namespace ActiveBasic
    … …  
    1314Class Control
    1415    Inherits WindowHandle
     16    Implements ActiveBasic.COM.InterfaceQuerable
    1517Public
    1618    /*!
    … …  
    2123
    2224    Sub Control()
     25        comImpl = New COM.ComClassDelegationImpl(This)
    2326    End Sub
    2427
    … …  
    3033    End Function
    3134
     35    /*!
     36    @brief HWNDからControlインスタンスを取得する。
     37    @param[in] hwnd 対象のウィンドウハンドル
     38    @return 対応するControlインスタンス。ただし、存在しなければNothing。
     39    */
    3240    Static Function FromHWnd(hwnd As HWND) As Control
    3341        FromHWnd = Nothing
    … …  
    3947Private
    4048    Static Function FromHWndCore(hwnd As HWND) As Control
    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
    46         End If
     49        FromHWndCore = _System_PtrObj(GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As VoidPtr) As Control
    4750    End Function
    4851
    … …  
    5861
    5962Public
    60     Sub Create(parent = Nothing As Control, style = 0 As DWord, exStyle = 0 As DWord, hmenu = 0 As HMENU)
     63    /*!
     64    @brief ウィンドウを作成する（詳細版）。
     65    @date 2008/08/02
     66    通常はCreateやCreateFormその他を使ってください。
     67    */
     68    Sub CreateEx(parent As Control, style As DWord, exStyle As DWord, hmenu As HMENU)
    6169        Dim cs As CREATESTRUCT
    6270        With cs
    … …  
    6472            .lpszClass = (atom As ULONG_PTR) As LPCTSTR
    6573            .lpszName = 0
    66             .style = style Or WS_CHILD Or WS_VISIBLE
     74            .style = style
    6775            .x = 0
    6876            .y = 0
    … …  
    7381            Else
    7482                .hwndParent = parent As HWND
    75                 .style Or= WS_CHILD
    7683            End If
    7784            .hMenu = hmenu
    … …  
    8289    End Sub
    8390
    84     Sub Create(parent As Control, style As DWord, exStyle As DWord, id As Long)
    85         Create(parent, style, exStyle, id As HMENU)
     91    /*!
     92    @brief ウィンドウを作成する（子ウィンドウ以外）。
     93    @date 2008/08/02
     94    */
     95    Sub CreateForm(style As DWord, exStyle As DWord, owner = Nothing As Control, hmenu = 0 As HMENU)
     96        CreateEx(owner, style, exStyle, hmenu)
     97    End Sub
     98
     99    Sub CreateForm()
     100        CreateEx(Nothing, 0, 0, 0)
     101    End Sub
     102
     103    /*!
     104    @brief 子ウィンドウを作成する。
     105    @date 2008/08/02
     106    */
     107    Sub Create(parent As Control, style = 0 As DWord, exStyle = 0 As DWord, id = 0 As Long)
     108        CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU)
    86109    End Sub
    87110Protected
    … …  
    89112
    90113    Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
    91         Imports System.Runtime.InteropServices
    92 
    93114        If hwnd <> 0 Then
    94115            Throw New System.InvalidOperationException("Window already created.")
    95116        End If
    96 
    97         Dim gch = GCHandle.Alloc(This)
    98         TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
    99117
    100118        StartWndProc()
    … …  
    105123                .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
    106124            If hwnd = 0 Then
    107                 Debug
    108125                ActiveBasic.Windows.ThrowByWindowsError(GetLastError())
    109126            End If
    110127           
    111128            If IsNothing(FromHWndCore(hwnd)) <> False Then
    112                 AssociateHWnd(gch, hwnd)
     129                AssociateHWnd(hwnd)
    113130                TlsSetValue(tlsIndex, 0)
    114131            End If
    … …  
    158175    End Function
    159176
    160     /*!
    161     @brief  最初にウィンドウプロシージャが呼ばれるときに実行される関数
    162     ここでは、主なメッセージハンドラの登録を行っている。
     177Protected
     178    /*!
     179    @brief  最初にウィンドウプロシージャを使うための前処理を行う関数
    163180    @date   2008/07/11
     181    WndProcFirstを使うときは、この関数を呼んでおく必要がある。
    164182    */
    165183    Sub StartWndProc()
     184        TlsSetValue(tlsIndex, ObjPtr(This))
     185        registerStandardEvent()
     186    End Sub
     187Private
     188    /*!
     189    @brief  主なメッセージハンドラの登録を行う関数
     190    @date   2008/08/02
     191    */
     192    Sub registerStandardEvent()
    166193        AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground))
    167194        Dim md = New MessageHandler(AddressOf(OnMouseDownBase))
    … …  
    210237            OnClick(Args.Empty)
    211238            OnMouseClick(me)
     239        Else
    212240            doubleClickFired = False
    213241        End If
    … …  
    225253    Sub OnMouseMoveBase(sender As Object, e As MessageArgs)
    226254        Dim me = makeMouseEventFromMsg(e)
    227         If mouseEntered Then
    228             OnMouseMove(me)
    229         Else
     255        If mouseEntered = False Then
    230256            mouseEntered = True
    231257            OnMouseEnter(me)
    232258            trackMouseEvent(TME_LEAVE Or TME_HOVER)
    233259        End If
     260        OnMouseMove(me)
    234261    End Sub
    235262
    … …  
    338365'--------------------------------
    339366' 初期ウィンドウクラス
    340 Private
     367Protected
    341368    Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    342369        Imports System.Runtime.InteropServices
    … …  
    344371        Dim rThis = FromHWndCore(hwnd)
    345372        If IsNothing(rThis) Then
    346             Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR
     373            rThis = _System_PtrObj(TlsGetValue(tlsIndex)) As Control
    347374            TlsSetValue(tlsIndex, 0)
    348             If gchValue = 0 Then
     375            If IsNothing(rThis) Then
    349376                Goto *InstanceIsNotFound
    350377            End If
    351             Dim gch = GCHandle.FromIntPtr(gchValue)
    352             rThis = gch.Target As Control
    353378            ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
    354 
    355             AssociateHWnd(gch, hwnd)
     379            rThis.AssociateHWnd(hwnd)
    356380        End If
    357381        If msg = WM_NCDESTROY Then
    … …  
    375399    /*!
    376400    @brief  Controlインスタンスとウィンドウハンドルを結び付ける。
    377     @param[in] 結び付けられるControlインスタンスを格納したGCHandle
    378401    @param[in] hwnd 結び付けるウィンドウハンドル
    379402    @date   2008/07/16
    380     これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。
    381     */
    382     Static Sub AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND)
    383         Imports System.Runtime.InteropServices
    384         Dim rThis = gch.Target As Control
    385         If IsNothing(rThis) Then
    386             Exit Sub
    387         End If
    388         rThis.hwnd = hwnd
    389         rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE
     403    これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、
     404    FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。
     405    */
     406    Sub AssociateHWnd(hwnd As HWND)
     407        This.hwnd = hwnd
     408        This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE
     409        comImpl.AddRef()
    390410    End Sub
    391411
    … …  
    412432
    413433    Sub UnassociateHWnd()
    414         Imports System.Runtime.InteropServices
    415         Dim gchValue = Prop(PropertyInstance) As ULONG_PTR
    416         If gchValue <> 0 Then
    417             GCHandle.FromIntPtr(gchValue).Free()
    418         End If
     434        comImpl.Release()
    419435    End Sub
    420436
    … …  
    422438'   Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
    423439
     440'--------------------------------
     441'   インタフェース実装
     442
     443Public
     444    Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT
     445        QueryInterfaceImpl = E_NOTIMPL
     446    End Function
     447
     448Private
     449    comImpl As COM.ComClassDelegationImpl
    424450'--------------------------------
    425451'   その他の補助関数

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

    r564 r575  
    1717    Sub MessageArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM)
    1818        msg = message
    19 '       hwnd = hwndSrc
     19        hwnd = hwndSrc
    2020        wp = wParam
    2121        lp = lParam
    … …  
    2727    End Function
    2828
    29 '   Const Function HWnd() As HWND
    30 '       HWnd = hwnd
    31 '   End Function
     29    Const Function HWnd() As HWND
     30        HWnd = hwnd
     31    End Function
    3232
    3333    Const Function WParam() As WPARAM
    … …  
    4848Private
    4949    msg As DWord
    50 '   hwnd As HWND
     50    hwnd As HWND
    5151    wp As WPARAM
    5252    lp As LPARAM

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

    r561 r575  
    101101        Dim pszMsg As PCSTR
    102102        FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS,
    103             0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg), 0, 0)
     103            0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) As PTSTR, 0, 0)
    104104        If pszMsg <> 0 Then
    105105            hresultToString = New String(pszMsg)

  • trunk/ab5.0/ablib/src/api_window.sbp

    r559 r575  
    10681068Const GWL_USERDATA =      -21
    10691069Const GWL_ID =            -12
     1070Const DWL_MSGRESULT = 0
     1071Const DWL_DLGPROC = 4
     1072Const DWL_USER = 8
    10701073#endif
    10711074
    … …  
    10791082Const GWLP_ID =           -12
    10801083
     1084
     1085Const DWLP_MSGRESULT = 0
     1086Const DWLP_DLGPROC = DWLP_MSGRESULT + SizeOf(LRESULT)
     1087Const DWLP_USER = DWLP_DLGPROC + SizeOf(DLGPROC)
    10811088
    10821089#ifdef _WIN64

  • trunk/ab5.0/ablib/src/api_windowstyles.sbp

    r497 r575  
    232232Const DS_CENTERMOUSE =    &H1000
    233233Const DS_CONTEXTHELP =    &H2000
     234
     235Const DS_SHELLFONT = (DS_SETFONT Or DS_FIXEDSYS)

  • trunk/ab5.0/ablib/src/windows.sbp

    r497 r575  
    2525#require <api_reg.sbp>
    2626
    27 #ifndef WIN32_LEAN_AND_MEAN
    2827#require <api_mmsys.sbp>
    2928#require <ole2.ab>
    3029#require <api_commdlg.sbp>
    31 #endif
    3230
    33 #ifdef INC_OLE2
    34 #require <ole2.ab>
    35 #endif
    36 
    37 #ifndef NOIME
    3831#require <api_imm.sbp>
    39 #endif
    4032
    4133#require <api_commctrl.sbp>
Note: See TracChangeset for help on using the changeset viewer.