Index: /trunk/ab5.0/ablib/TestCase/UI_Sample/step11_TextEditoer.ab =================================================================== --- /trunk/ab5.0/ablib/TestCase/UI_Sample/step11_TextEditoer.ab (revision 574) +++ /trunk/ab5.0/ablib/TestCase/UI_Sample/step11_TextEditoer.ab (revision 575) @@ -22,8 +22,10 @@ Sub MyForm() AddResize(AddressOf(OnResize)) - Create() + CreateForm() myEdit = New EditBox - myEdit.Create(This, ES_MULTILINE Or ES_WANTRETURN Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or WS_HSCROLL Or WS_VSCROLL, WS_EX_CLIENTEDGE) - myEdit.SendMessage(WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT) As WPARAM, 0) + With myEdit + .Create(This, ES_MULTILINE Or ES_WANTRETURN Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or WS_HSCROLL Or WS_VSCROLL, WS_EX_CLIENTEDGE) + .SendMessage(WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT) As WPARAM, 0) + End With Show(SW_SHOWDEFAULT) End Sub Index: /trunk/ab5.0/ablib/TestCase/UI_Sample/step5_DayTimeCheck.ab =================================================================== --- /trunk/ab5.0/ablib/TestCase/UI_Sample/step5_DayTimeCheck.ab (revision 574) +++ /trunk/ab5.0/ablib/TestCase/UI_Sample/step5_DayTimeCheck.ab (revision 575) @@ -62,5 +62,5 @@ Sub ButtonTime_Click(sender As Object, e As Args) - TaskMsg(This, "今日の日付", DateTime.Now.GetDateTimeFormats("H:mm:ss"), Nothing, MB_OK) + TaskMsg(This, "現在時刻", DateTime.Now.GetDateTimeFormats("H:mm:ss"), Nothing, MB_OK) End Sub @@ -71,4 +71,4 @@ Control.Initialize(GetModuleHandle(0)) Dim f = New DayTimeCheckForm -f.Create() +f.CreateForm() Application.Run(f) Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab (revision 574) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Application.ab (revision 575) @@ -1,7 +1,11 @@ 'Classes/ActiveBasic/Windows/UI/Application.ab + +#require Namespace ActiveBasic Namespace Windows Namespace UI + +Delegate Function MessageFilter(m As *MSG) As Boolean /*! @@ -23,5 +27,5 @@ form.Show(SW_SHOW) form.Update() - form.AddMessageEvent(WM_DESTROY, AddressOf(Application.OnMainFormClosed)) + form.AddMessageEvent(WM_DESTROY, AddressOf(OnMainFormClosed)) End If @@ -32,6 +36,5 @@ Exit Do End If - TranslateMessage(m) - DispatchMessage(m) + dispatchMessage(m) Loop @@ -70,10 +73,20 @@ PostQuitMessage(0) 'Run()で捕まえてくれるようPostしなおす。 Case Else - TranslateMessage(msg) - DispatchMessage(msg) + dispatchMessage(msg) End Select Wend End Sub +/* + Static Sub AddMessageFilter(mf As MessageFilter) + If IsNothing(filter) Then + filter = New System.Collections.Generic.List + End If + filter.Add(mf) + End Sub + Static Sub RemoveMessageFilter(mf As MessageFilter) + filter.Remove(mf) + End Sub +*/ #include "ApplicationEvent.sbp" @@ -83,4 +96,15 @@ ExitThread() End Sub + + Static Sub dispatchMessage(ByRef m As MSG) +/* If IsNothing(filter) = False Then + For Each f In filter + Next + End If +*/ TranslateMessage(m) + DispatchMessage(m) + End Sub + +' Static filter As System.Collections.Generic.List End Class Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 574) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab (revision 575) @@ -2,4 +2,5 @@ #require +#require Namespace ActiveBasic @@ -13,4 +14,5 @@ Class Control Inherits WindowHandle + Implements ActiveBasic.COM.InterfaceQuerable Public /*! @@ -21,4 +23,5 @@ Sub Control() + comImpl = New COM.ComClassDelegationImpl(This) End Sub @@ -30,4 +33,9 @@ End Function + /*! + @brief HWNDからControlインスタンスを取得する。 + @param[in] hwnd 対象のウィンドウハンドル + @return 対応するControlインスタンス。ただし、存在しなければNothing。 + */ Static Function FromHWnd(hwnd As HWND) As Control FromHWnd = Nothing @@ -39,10 +47,5 @@ Private Static Function FromHWndCore(hwnd As HWND) As Control - Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR - If gchValue <> 0 Then - Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue) - FromHWndCore = gch.Target As Control - Exit Function - End If + FromHWndCore = _System_PtrObj(GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As VoidPtr) As Control End Function @@ -58,5 +61,10 @@ Public - Sub Create(parent = Nothing As Control, style = 0 As DWord, exStyle = 0 As DWord, hmenu = 0 As HMENU) + /*! + @brief ウィンドウを作成する（詳細版）。 + @date 2008/08/02 + 通常はCreateやCreateFormその他を使ってください。 + */ + Sub CreateEx(parent As Control, style As DWord, exStyle As DWord, hmenu As HMENU) Dim cs As CREATESTRUCT With cs @@ -64,5 +72,5 @@ .lpszClass = (atom As ULONG_PTR) As LPCTSTR .lpszName = 0 - .style = style Or WS_CHILD Or WS_VISIBLE + .style = style .x = 0 .y = 0 @@ -73,5 +81,4 @@ Else .hwndParent = parent As HWND - .style Or= WS_CHILD End If .hMenu = hmenu @@ -82,6 +89,22 @@ End Sub - Sub Create(parent As Control, style As DWord, exStyle As DWord, id As Long) - Create(parent, style, exStyle, id As HMENU) + /*! + @brief ウィンドウを作成する（子ウィンドウ以外）。 + @date 2008/08/02 + */ + Sub CreateForm(style As DWord, exStyle As DWord, owner = Nothing As Control, hmenu = 0 As HMENU) + CreateEx(owner, style, exStyle, hmenu) + End Sub + + Sub CreateForm() + CreateEx(Nothing, 0, 0, 0) + End Sub + + /*! + @brief 子ウィンドウを作成する。 + @date 2008/08/02 + */ + Sub Create(parent As Control, style = 0 As DWord, exStyle = 0 As DWord, id = 0 As Long) + CreateEx(parent, style Or WS_CHILD Or WS_VISIBLE, exStyle, id As ULONG_PTR As HMENU) End Sub Protected @@ -89,12 +112,7 @@ Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control) - Imports System.Runtime.InteropServices - If hwnd <> 0 Then Throw New System.InvalidOperationException("Window already created.") End If - - Dim gch = GCHandle.Alloc(This) - TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) StartWndProc() @@ -105,10 +123,9 @@ .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) If hwnd = 0 Then - Debug ActiveBasic.Windows.ThrowByWindowsError(GetLastError()) End If If IsNothing(FromHWndCore(hwnd)) <> False Then - AssociateHWnd(gch, hwnd) + AssociateHWnd(hwnd) TlsSetValue(tlsIndex, 0) End If @@ -158,10 +175,20 @@ End Function - /*! - @brief 最初にウィンドウプロシージャが呼ばれるときに実行される関数 - ここでは、主なメッセージハンドラの登録を行っている。 +Protected + /*! + @brief 最初にウィンドウプロシージャを使うための前処理を行う関数 @date 2008/07/11 + WndProcFirstを使うときは、この関数を呼んでおく必要がある。 */ Sub StartWndProc() + TlsSetValue(tlsIndex, ObjPtr(This)) + registerStandardEvent() + End Sub +Private + /*! + @brief 主なメッセージハンドラの登録を行う関数 + @date 2008/08/02 + */ + Sub registerStandardEvent() AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground)) Dim md = New MessageHandler(AddressOf(OnMouseDownBase)) @@ -210,4 +237,5 @@ OnClick(Args.Empty) OnMouseClick(me) + Else doubleClickFired = False End If @@ -225,11 +253,10 @@ Sub OnMouseMoveBase(sender As Object, e As MessageArgs) Dim me = makeMouseEventFromMsg(e) - If mouseEntered Then - OnMouseMove(me) - Else + If mouseEntered = False Then mouseEntered = True OnMouseEnter(me) trackMouseEvent(TME_LEAVE Or TME_HOVER) End If + OnMouseMove(me) End Sub @@ -338,5 +365,5 @@ '-------------------------------- ' 初期ウィンドウクラス -Private +Protected Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT Imports System.Runtime.InteropServices @@ -344,14 +371,11 @@ Dim rThis = FromHWndCore(hwnd) If IsNothing(rThis) Then - Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR + rThis = _System_PtrObj(TlsGetValue(tlsIndex)) As Control TlsSetValue(tlsIndex, 0) - If gchValue = 0 Then + If IsNothing(rThis) Then Goto *InstanceIsNotFound End If - Dim gch = GCHandle.FromIntPtr(gchValue) - rThis = gch.Target As Control ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき - - AssociateHWnd(gch, hwnd) + rThis.AssociateHWnd(hwnd) End If If msg = WM_NCDESTROY Then @@ -375,17 +399,13 @@ /*! @brief Controlインスタンスとウィンドウハンドルを結び付ける。 - @param[in] 結び付けられるControlインスタンスを格納したGCHandle @param[in] hwnd 結び付けるウィンドウハンドル @date 2008/07/16 - これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。 - */ - Static Sub AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) - Imports System.Runtime.InteropServices - Dim rThis = gch.Target As Control - If IsNothing(rThis) Then - Exit Sub - End If - rThis.hwnd = hwnd - rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE + これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなると共に、 + FromHWndでウィンドウハンドルからControlインスタンスの取得が可能となる。 + */ + Sub AssociateHWnd(hwnd As HWND) + This.hwnd = hwnd + This.Prop[PropertyInstance] = ObjPtr(This) As HANDLE + comImpl.AddRef() End Sub @@ -412,9 +432,5 @@ Sub UnassociateHWnd() - Imports System.Runtime.InteropServices - Dim gchValue = Prop(PropertyInstance) As ULONG_PTR - If gchValue <> 0 Then - GCHandle.FromIntPtr(gchValue).Free() - End If + comImpl.Release() End Sub @@ -422,4 +438,14 @@ ' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord +'-------------------------------- +' インタフェース実装 + +Public + Virtual Function QueryInterfaceImpl(ByRef iid As IID, ByRef pv As VoidPtr) As HRESULT + QueryInterfaceImpl = E_NOTIMPL + End Function + +Private + comImpl As COM.ComClassDelegationImpl '-------------------------------- ' その他の補助関数 Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab (revision 574) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab (revision 575) @@ -17,5 +17,5 @@ Sub MessageArgs(hwndSrc As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) msg = message -' hwnd = hwndSrc + hwnd = hwndSrc wp = wParam lp = lParam @@ -27,7 +27,7 @@ End Function -' Const Function HWnd() As HWND -' HWnd = hwnd -' End Function + Const Function HWnd() As HWND + HWnd = hwnd + End Function Const Function WParam() As WPARAM @@ -48,5 +48,5 @@ Private msg As DWord -' hwnd As HWND + hwnd As HWND wp As WPARAM lp As LPARAM Index: /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab =================================================================== --- /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab (revision 574) +++ /trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Windows.ab (revision 575) @@ -101,5 +101,5 @@ Dim pszMsg As PCSTR FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, - 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg), 0, 0) + 0, hr, LANG_USER_DEFAULT, VarPtr(pszMsg) As PTSTR, 0, 0) If pszMsg <> 0 Then hresultToString = New String(pszMsg) Index: /trunk/ab5.0/ablib/src/api_window.sbp =================================================================== --- /trunk/ab5.0/ablib/src/api_window.sbp (revision 574) +++ /trunk/ab5.0/ablib/src/api_window.sbp (revision 575) @@ -1068,4 +1068,7 @@ Const GWL_USERDATA = -21 Const GWL_ID = -12 +Const DWL_MSGRESULT = 0 +Const DWL_DLGPROC = 4 +Const DWL_USER = 8 #endif @@ -1079,4 +1082,8 @@ Const GWLP_ID = -12 + +Const DWLP_MSGRESULT = 0 +Const DWLP_DLGPROC = DWLP_MSGRESULT + SizeOf(LRESULT) +Const DWLP_USER = DWLP_DLGPROC + SizeOf(DLGPROC) #ifdef _WIN64 Index: /trunk/ab5.0/ablib/src/api_windowstyles.sbp =================================================================== --- /trunk/ab5.0/ablib/src/api_windowstyles.sbp (revision 574) +++ /trunk/ab5.0/ablib/src/api_windowstyles.sbp (revision 575) @@ -232,2 +232,4 @@ Const DS_CENTERMOUSE = &H1000 Const DS_CONTEXTHELP = &H2000 + +Const DS_SHELLFONT = (DS_SETFONT Or DS_FIXEDSYS) Index: /trunk/ab5.0/ablib/src/windows.sbp =================================================================== --- /trunk/ab5.0/ablib/src/windows.sbp (revision 574) +++ /trunk/ab5.0/ablib/src/windows.sbp (revision 575) @@ -25,17 +25,9 @@ #require -#ifndef WIN32_LEAN_AND_MEAN #require #require #require -#endif -#ifdef INC_OLE2 -#require -#endif - -#ifndef NOIME #require -#endif #require