Index: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab
===================================================================
--- trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab	(revision 547)
+++ trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab	(revision 551)
@@ -14,4 +14,9 @@
 	Inherits WindowHandle
 Public
+	/*!
+	@brief Destroyイベントよりも後に呼ばれるDestroyイベントデリゲート
+	@date	2008/07/16
+	*/
+	finalDestroy As ActiveBasic.Windows.UI.Handler
 
 	Sub Control()
@@ -34,11 +39,9 @@
 Private
 	Static Function FromHWndCore(hwnd As HWND) As Control
-		If _System_GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
-			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
+		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
 	End Function
@@ -55,16 +58,35 @@
 
 Public
-	Sub Create()
+	Sub Create(parent = Nothing As Control, style = 0 As DWord, exStyle = 0 As DWord, hmenu = 0 As HMENU)
 		Dim cs As CREATESTRUCT
-		cs.hInstance = hInstance
-		cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR
+		With cs
+			.dwExStyle = exStyle
+			.lpszClass = (atom As ULONG_PTR) As LPCTSTR
+			.lpszName = 0
+			.style = style Or WS_CHILD Or WS_VISIBLE
+			.x = CW_USEDEFAULT
+			.y = CW_USEDEFAULT
+			.cx = CW_USEDEFAULT
+			.cy = CW_USEDEFAULT
+			If IsNothing(parent) Then
+				.hwndParent = 0
+			Else
+				.hwndParent = parent As HWND
+				.style Or= WS_CHILD
+			End If
+			.hMenu = hmenu
+			.hInstance = hInstance
+		End With
 		GetCreateStruct(cs)
-		createImpl(cs)
-	End Sub
-
+		createImpl(cs, parent)
+	End Sub
+
+	Sub Create(parent As Control, style As DWord, exStyle As DWord, id As Long)
+		Create(parent, style, exStyle, id As HMENU)
+	End Sub
 Protected
 	Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
 
-	Sub createImpl(ByRef cs As CREATESTRUCT)
+	Sub createImpl(ByRef cs As CREATESTRUCT, parent As Control)
 		Imports System.Runtime.InteropServices
 
@@ -75,10 +97,20 @@
 
 		With cs
-			Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
+			'よそのクラスの場合、WndProcFirst内のhwndの代入が行われないため、ここでも行っておく。
+			hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
 				.x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
 			If hwnd = 0 Then
 				ActiveBasic.Windows.ThrowByWindowsError(GetLastError())
 			End If
+			
+			If IsNothing(FromHWndCore(hwnd)) <> False Then
+				AssociateHWnd(gch, hwnd)
+				TlsSetValue(tlsIndex, 0)
+			End If
 		End With
+
+		If IsNothing(parent) = False Then
+			RegisterUnassociateHWnd(parent)
+		End If
 	End Sub
 
@@ -88,9 +120,9 @@
 Public
 	Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-		Dim h = Nothing As MessageEventHandler
+		Dim h = Nothing As MessageHandler
 		Dim b = messageMap.TryGetValue(Hex$(msg), h)
 		If b Then
 			If Not IsNothing(h) Then
-				Dim a = New MessageEventArgs(hwnd, msg, wp, lp)
+				Dim a = New MessageArgs(hwnd, msg, wp, lp)
 				h(This, a)
 				WndProc = a.LResult
@@ -106,5 +138,5 @@
 
 Private
-	Static Function makeKeysFormMsg(e As MessageEventArgs) As Keys
+	Static Function makeKeysFormMsg(e As MessageArgs) As Keys
 		Dim t As DWord
 		t = e.WParam And Keys.KeyCode
@@ -115,8 +147,8 @@
 	End Function
 
-	Static Function makeMouseEventFromMsg(e As MessageEventArgs) As MouseEventArgs
+	Static Function makeMouseEventFromMsg(e As MessageArgs) As MouseArgs
 		Dim wp = e.WParam
 		Dim lp = e.LParam
-		makeMouseEventFromMsg = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
+		makeMouseEventFromMsg = New MouseArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
 	End Function
 
@@ -128,15 +160,15 @@
 	Sub StartWndProc()
 		AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground))
-		Dim md = New MessageEventHandler(AddressOf(OnMouseDownBase))
+		Dim md = New MessageHandler(AddressOf(OnMouseDownBase))
 		AddMessageEvent(WM_LBUTTONDOWN, md)
 		AddMessageEvent(WM_RBUTTONDOWN, md)
 		AddMessageEvent(WM_MBUTTONDOWN, md)
 		AddMessageEvent(WM_XBUTTONDOWN, md)
-		Dim mu = New MessageEventHandler(AddressOf(OnMouseUpBase))
+		Dim mu = New MessageHandler(AddressOf(OnMouseUpBase))
 		AddMessageEvent(WM_LBUTTONUP, mu)
 		AddMessageEvent(WM_RBUTTONUP, mu)
 		AddMessageEvent(WM_MBUTTONUP, mu)
 		AddMessageEvent(WM_XBUTTONUP, mu)
-		Dim mb = New MessageEventHandler(AddressOf(OnMouseDblClkBase))
+		Dim mb = New MessageHandler(AddressOf(OnMouseDblClkBase))
 		AddMessageEvent(WM_LBUTTONDBLCLK, mu)
 		AddMessageEvent(WM_RBUTTONDBLCLK, mu)
@@ -148,9 +180,9 @@
 		AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
 		AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
-'		AddMessageEvent(WM_CHAR, AddressOf(OnChar))	
+		AddMessageEvent(WM_CHAR, AddressOf(OnChar))	
 		AddMessageEvent(WM_CREATE, AddressOf(OnCreateBase))
 	End Sub
 
-	Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
+	Sub OnEraseBackground(sender As Object, e As MessageArgs)
 		Dim rc = ClientRect
 		FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
@@ -158,12 +190,12 @@
 	End Sub
 
-	Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
+	Sub OnMouseDownBase(sender As Object, e As MessageArgs)
 		OnMouseDown(makeMouseEventFromMsg(e))
 	End Sub
 
-	Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
+	Sub OnMouseUpBase(sender As Object, e As MessageArgs)
 		Dim me = makeMouseEventFromMsg(e)
 		If doubleClickFired = False Then
-'			OnClick(System.EventArgs.Empty)
+'			OnClick(System.Args.Empty)
 			OnMouseClick(me)
 			doubleClickFired = False
@@ -172,13 +204,13 @@
 	End Sub
 
-	Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
+	Sub OnMouseDblClkBase(sender As Object, e As MessageArgs)
 		Dim me = makeMouseEventFromMsg(e)
 		doubleClickFired = True
 		OnMouseDown(me)
-'		OnDoubleClick(System.EventArgs.Empty)
+'		OnDoubleClick(System.Args.Empty)
 		OnMouseDoubleClick(me)
 	End Sub
 
-	Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
+	Sub OnMouseMoveBase(sender As Object, e As MessageArgs)
 		Dim me = makeMouseEventFromMsg(e)
 		If mouseEntered Then
@@ -190,5 +222,5 @@
 	End Sub
 
-	Sub OnMouseLeaveBase(sender As Object, e As MessageEventArgs)
+	Sub OnMouseLeaveBase(sender As Object, e As MessageArgs)
 		Dim me = makeMouseEventFromMsg(e)
 		OnMouseLeave(me)
@@ -196,9 +228,9 @@
 	End Sub
 
-	Sub OnPaintBase(sender As Object, e As MessageEventArgs)
+	Sub OnPaintBase(sender As Object, e As MessageArgs)
 		Dim ps As PAINTSTRUCT
 		BeginPaint(ps)
 		Try
-			OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
+			OnPaintDC(New PaintDCArgs(ps.hdc, ps.rcPaint))
 		Finally
 			EndPaint(ps)
@@ -206,22 +238,21 @@
 	End Sub
 
-	Sub OnKeyDownBase(sender As Object, e As MessageEventArgs)
-		OnKeyDown(New KeyEventArgs(makeKeysFormMsg(e)))
-	End Sub
-
-	Sub OnKeyUpBase(sender As Object, e As MessageEventArgs)
-		OnKeyUp(New KeyEventArgs(makeKeysFormMsg(e)))
-	End Sub
-
-'	コメントアウト解除のときはStartWndProcのコメントアウト解除も忘れないこと
-'	Sub OnChar(sender As Object, e As MessageEventArgs)
-'		OnKeyPress(New KeyPressEventArgs(e.WParam As Char))
-'	End Sub
-
-	Sub OnCreateBase(sender As Object, e As MessageEventArgs)
-		OnCreate(New CreateEventArgs(e.LParam As *CREATESTRUCT))
-	End Sub
-
-	messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
+	Sub OnKeyDownBase(sender As Object, e As MessageArgs)
+		OnKeyDown(New KeyArgs(makeKeysFormMsg(e)))
+	End Sub
+
+	Sub OnKeyUpBase(sender As Object, e As MessageArgs)
+		OnKeyUp(New KeyArgs(makeKeysFormMsg(e)))
+	End Sub
+
+	Sub OnChar(sender As Object, e As MessageArgs)
+		OnKeyPress(New KeyPressArgs(e.WParam As Char))
+	End Sub
+
+	Sub OnCreateBase(sender As Object, e As MessageArgs)
+'		OnCreate(New CreateArgs(e.LParam As *CREATESTRUCT))
+	End Sub
+
+	messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageHandler>
 
 Public
@@ -230,11 +261,11 @@
 	@date	2007/12/04
 	*/
-	Sub AddMessageEvent(message As DWord, h As MessageEventHandler)
+	Sub AddMessageEvent(message As DWord, h As MessageHandler)
 		If Not IsNothing(h) Then
 			If IsNothing(messageMap) Then
-				messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
+				messageMap = New System.Collections.Generic.Dictionary<Object, MessageHandler>
 			End If
 			Dim msg = Hex$(message)
-			Dim m = Nothing As MessageEventHandler
+			Dim m = Nothing As MessageHandler
 			If messageMap.TryGetValue(msg, m) Then
 				messageMap.Item[msg] = m + h
@@ -249,5 +280,5 @@
 	@date	2007/12/04
 	*/
-	Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler)
+	Sub RemoveMessageEvent(message As DWord, a As MessageHandler)
 		If Not IsNothing(a) Then
 			If Not IsNothing(messageMap) Then
@@ -302,18 +333,17 @@
 			' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
 
-			If IsNothing(rThis) Then
+			If AssociateHWnd(gch, hwnd) = False Then
 				Goto *InstanceIsNotFound
 			End If
-			rThis.hwnd = hwnd
-			rThis.Prop[PropertyInstance] = gchValue As HANDLE
+		End If
+		If msg = WM_NCDESTROY Then
+			rThis.UnassociateHWnd()
+		End If
+		If msg = WM_DESTROY And IsNothing(rThis.finalDestroy) = False Then
+			Dim f = rThis.finalDestroy
+			f(rThis, Args.Empty)
+'			finalDestroy(This, Args.Empty)
 		End If
 		WndProcFirst = rThis.WndProc(msg, wp, lp)
-		If msg = WM_NCDESTROY Then
-			Dim gchValue = rThis.Prop(PropertyInstance) As ULONG_PTR
-			If gchValue <> 0 Then
-				GCHandle.FromIntPtr(gchValue).Free()
-			End If
-		End If
-
 		Exit Function
 
@@ -322,4 +352,50 @@
 		WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
 	End Function
+
+	/*!
+	@brief	Controlインスタンスとウィンドウハンドルを結び付ける。
+	@param[in] 結び付けられるControlインスタンスを格納したGCHandle
+	@param[in] hwnd	結び付けるウィンドウハンドル
+	@date	2008/07/16
+	これを実行することで、UnassociateHWndされるまでControlがGC対象にならなくなる。
+	*/
+	Static Function AssociateHWnd(gch As System.Runtime.InteropServices.GCHandle, hwnd As HWND) As Boolean
+		Imports System.Runtime.InteropServices
+		Dim rThis = gch.Target As Control
+		If IsNothing(rThis) Then
+			Exit Function
+		End If
+		rThis.hwnd = hwnd
+		rThis.Prop[PropertyInstance] = GCHandle.ToIntPtr(gch) As HANDLE
+	End Function
+
+	/*!
+	@brief	オーナーの破棄時にこのControlインスタンスとウィンドウハンドルの結び付けを解除するよう登録する。
+	@param[in] owner 結び付けの解除を連動させるControl
+	@date	2008/07/16
+	ownerのFinalDestoryでこのControlとHWNDとの結び付けを解除する。
+	*/
+	Sub RegisterUnassociateHWnd(owner As Control)
+		If IsNothing(owner) = False Then
+			Dim e = New Handler(AddressOf(UnassociateHWndOnEvent))
+			If IsNothing(finalDestroy) Then
+				owner.finalDestroy = e
+			Else
+				owner.finalDestroy += e
+			End If
+		End If
+	End Sub
+
+	Sub UnassociateHWndOnEvent(sender As Object, e As Args)
+		UnassociateHWnd()
+	End Sub
+
+	Sub UnassociateHWnd()
+		Imports System.Runtime.InteropServices
+		Dim gchValue = Prop(PropertyInstance) As ULONG_PTR
+		If gchValue <> 0 Then
+			GCHandle.FromIntPtr(gchValue).Free()
+		End If
+	End Sub
 
 '	Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
