Changeset 575


Ignore:
Timestamp:
Aug 3, 2008, 3:58:05 AM (13 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.