Index: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/Control.ab
===================================================================
--- trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/Control.ab	(revision 506)
+++ trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Forms/Control.ab	(revision 542)
@@ -8,4 +8,8 @@
 Namespace Forms
 
+'Namespace Detail
+'	TypeDef PTrackMouseEvent = *Function(ByRef tme As TRACKMOUSEEVENT) As BOOL
+'End Namespace
+
 Class Control
 Public
@@ -19,6 +23,6 @@
 	End Sub
 
-	Function Handle() As WindowHandle
-		Handle = wnd
+	Function Handle() As HWND
+		Handle = hwnd
 	End Function
 
@@ -53,4 +57,5 @@
 		menu = 0 As HMENU) As HWND
 */
+
 Public
 	Function Create() As Boolean
@@ -71,4 +76,6 @@
 		TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
 
+		StartWndProc()
+
 		With cs
 			Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
@@ -83,24 +90,9 @@
 Public
 	Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
+/*
 		Select Case msg
-			Case WM_ERASEBKGND
-				Dim rc = wnd.ClientRect
-				Dim e = New PaintDCHandledEventArgs(wp As HDC, rc)
-				OnPaintBackground(e)
-				WndProc = e.Handled
-			Case WM_PAINT
-				Dim ps As PAINTSTRUCT
-				wnd.BeginPaint(ps)
-				Try
-					Dim e = New PaintDCEventArgs(ps.hdc, ps.rcPaint)
-					OnPaintDC(e)
-				Finally
-					wnd.EndPaint(ps)
-				End Try
-			Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN, WM_XBUTTONDOWN
-				OnMouseDown(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0))
-			Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP, WM_XBUTTONUP
-				OnMouseUp(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0))
-/*
+			Case WM_MOUSELEAVE
+				OnMouseLeave(makeMouseEventFromWPLP(wp, lp))
+				mouseEntered = False
 			Case WM_KEYDOWN
 				OnKeyDown(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
@@ -108,23 +100,31 @@
 				OnKeyUp(New KeyEventArgs(makeKeysFormWPLP(wp, lp)))
 			Case WM_CHAR
-				OnKeyPress(New KeyPressEventArgs(wParam As Char))
-			Case WM_ENABLE
-				OnEnableChanged(EventArgs.Empty)
-			Case WM_MOVE
-				OnMove(EventArgs.Empty)
-			Case WM_SIZE
-				OnResize(EventArgs.Empty)
+				OnKeyPress(New KeyPressEventArgs(wp As Char))
+'			Case WM_CREATE
+			Case WM_DESTROY
+				OnDestroy(EventArgs.Empty)
+			Case Else
+				WndProc = DefWndProc(msg, wp, lp)
+		End Select
 */
-			Case Else
-			WndProc = DefWndProc(msg, wp, lp)
-		End Select
+		Dim h = Nothing As MessageEventHandler
+		Dim b = messageMap.TryGetValue(Hex$(msg), h)
+		If b Then
+			If Not IsNothing(h) Then
+				Dim a = New MessageEventArgs(hwnd, msg, wp, lp)
+				h(This, a)
+				WndProc = a.LResult
+				Exit Function
+			End If
+		End If
+		WndProc = DefWndProc(msg, wp, lp)
 	End Function
 
 	Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
-		DefWndProc = DefWindowProc(wnd.HWnd, msg, wp, lp)
-	End Function
-
-Private
-	Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
+		DefWndProc = DefWindowProc(hwnd, msg, wp, lp)
+	End Function
+
+Private
+	Static Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys
 		Dim t As DWord
 		t = wp And Keys.KeyCode
@@ -135,21 +135,126 @@
 	End Function
 
-
-'--------------------------------
-' ウィンドウメッセージ処理
-
-'--------
-' 2
-
-Protected
+	Static Function makeMouseEventFromWPLP(wp As WPARAM, lp As LPARAM) As MouseEventArgs
+		makeMouseEventFromWPLP = New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)
+	End Function
+
 	/*!
-	@biref	ウィンドウの背景を描画する。
+	@brief	最初にウィンドウプロシージャが呼ばれるときに実行される関数
+	ここでは、主なメッセージハンドラの登録を行っている。
+	@date	2008/07/11
+	*/
+	Sub StartWndProc()
+		Dim t = This '#177対策
+		messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
+		AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
+		Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
+		AddMessageEvent(WM_LBUTTONDOWN, md)
+		AddMessageEvent(WM_RBUTTONDOWN, md)
+		AddMessageEvent(WM_MBUTTONDOWN, md)
+		AddMessageEvent(WM_XBUTTONDOWN, md)
+		Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase))
+		AddMessageEvent(WM_LBUTTONUP, mu)
+		AddMessageEvent(WM_RBUTTONUP, mu)
+		AddMessageEvent(WM_MBUTTONUP, mu)
+		AddMessageEvent(WM_XBUTTONUP, mu)
+		Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase))
+		AddMessageEvent(WM_LBUTTONDBLCLK, mu)
+		AddMessageEvent(WM_RBUTTONDBLCLK, mu)
+		AddMessageEvent(WM_MBUTTONDBLCLK, mu)
+		AddMessageEvent(WM_XBUTTONDBLCLK, mu)
+		AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
+	End Sub
+
+	Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
+		Dim rc As RECT
+		Dim r = GetClientRect(hwnd, rc)
+		FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
+		e.LResult = TRUE
+	End Sub
+
+	Sub OnMouseDownBase(sender As Object, e As MessageEventArgs)
+		OnMouseDown(makeMouseEventFromWPLP(e.WParam, e.LParam))
+	End Sub
+
+	Sub OnMouseUpBase(sender As Object, e As MessageEventArgs)
+		Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+		If doubleClickFired = False Then
+			OnClick(EventArgs.Empty)
+			OnMouseClick(me)
+			doubleClickFired = False
+		End If
+		OnMouseUp(me)
+	End Sub
+
+	Sub OnMouseDblClkBase(sender As Object, e As MessageEventArgs)
+		Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+		doubleClickFired = True
+		OnMouseDown(me)
+		OnDoubleClick(EventArgs.Empty)
+		OnMouseDoubleClick(me)
+	End Sub
+
+	Sub OnMouseMoveBase(sender As Object, e As MessageEventArgs)
+		Dim me = makeMouseEventFromWPLP(e.WParam, e.LParam)
+		If mouseEntered Then
+			OnMouseMove(me)
+		Else
+			mouseEntered = True
+			OnMouseEnter(me)
+		End If
+	End Sub
+
+	Sub OnPaintBase(sender As Object, e As MessageEventArgs)
+		Dim ps As PAINTSTRUCT
+		BeginPaint(hwnd, ps)
+'		Try
+'			OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
+'		Finally
+			EndPaint(hwnd, ps)
+'		End Try
+	End Sub
+
+
+	messageMap As System.Collections.Generic.Dictionary<Object /*DWord*/, MessageEventHandler>
+
+Public
+	/*!
+	@biref	メッセージイベントハンドラを登録する。
 	@date	2007/12/04
 	*/
-	Virtual Sub OnPaintBackground(e As PaintDCBackGroundEventArgs)
-		Dim hbr = (COLOR_3DFACE + 1) As HBRUSH
-		FillRect(e.Handle, e.ClipRect, hbr)
-		e.Handled = True
-	End Sub
+	Sub AddMessageEvent(message As DWord, h As MessageEventHandler)
+		If Not IsNothing(h) Then
+			If IsNothing(messageMap) Then
+				messageMap = New System.Collections.Generic.Dictionary<Object, MessageEventHandler>
+			End If
+			Dim msg = Hex$(message)
+			Dim m = Nothing As MessageEventHandler
+			If messageMap.TryGetValue(msg, m) Then
+				messageMap.Item[msg] = m + h
+			Else
+				messageMap.Item[msg] = h
+			End If
+		End If
+	End Sub
+
+	/*!
+	@biref	メッセージイベントハンドラ登録を解除する。
+	@date	2007/12/04
+	*/
+	Sub RemoveMessageEvent(message As DWord, a As MessageEventHandler)
+		If Not IsNothing(a) Then
+			If Not IsNothing(messageMap) Then
+				Dim msg = Nothing As Object : msg = New System.UInt32(message)
+				Dim m = messageMap.Item[msg]
+				If Not IsNothing(m) Then
+					messageMap.Item[msg] = m - a
+				End If
+			End If
+		End If
+	End Sub
+
+'--------------------------------
+' ウィンドウメッセージ処理
+
 
 '--------
@@ -162,5 +267,16 @@
 ' 1 インスタンスメンバ変数
 Private
-	wnd As WindowHandle
+	hwnd As HWND
+	/*!
+	@brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
+	外から中に入ってきたときにMouseEnterイベントを発生させるために用意している。
+	*/
+	mouseEntered As Boolean
+	/*!
+	@brief ダブルクリックが起こったかどうかのフラグ
+	Click/MouseClickイベントのために用意している。
+	@date	2008/07/12
+	*/
+	doubleClickFired As Boolean
 
 '--------------------------------
@@ -184,6 +300,6 @@
 				Goto *InstanceIsNotFound
 			End If
-			rThis.wnd = New WindowHandle(hwnd)
-			rThis.wnd.SetProp(PropertyInstance, gchValue As HANDLE)
+			rThis.hwnd = hwnd
+			SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE)
 		End If
 		WndProcFirst = rThis.WndProc(msg, wp, lp)
@@ -202,11 +318,27 @@
 		WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
 	End Function
-	
+
 '	Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
 '	Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
 
 '--------------------------------
+'	その他の補助関数
+Private
+'	Sub tracMouseEvent()
+/*		If pTrackMouseEvent <> 0 Then
+			Dim tme As TRACKMOUSEEVENT
+			With tme
+				.cbSize = Len(tme)
+				.dwFlags = TME_HOVER Or TME_LEAVE
+				.hwndTrack = wnd
+				.dwHoverTime = HOVER_DEFAULT
+			End With
+			pTrackMouseEvent(tme)
+		End If
+*/	'End Sub
+
+'--------------------------------
 ' 1 初期化終了関連（特にウィンドウクラス）
-
+Private
 	'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
 	Static tlsIndex As DWord
@@ -214,4 +346,6 @@
 	Static hInstance As HINSTANCE
 	Static atom As ATOM
+	Static hmodComctl As HMODULE
+'	Static pTrackMouseEvent As PTrackMouseEvent
 
 	Static Const WindowClassName = "ActiveBasic.Windows.UI.Control"
@@ -221,4 +355,6 @@
 		tlsIndex = TlsAlloc()
 		hInstance = hinst
+'		hmodComctl = LoadLibrary("comctl32.dll")
+'		pTrackMouseEvent = GetProcAddress(hmodComctl, ToMBStr("_TrackMouseEvent"))
 
 		Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId())
@@ -251,29 +387,21 @@
 
 	Static Sub Uninitialize()
-		UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
-		TlsFree(tlsIndex)
-		GlobalDeleteAtom(PropertyInstance)
-	End Sub
+		If atom <> 0 Then
+			UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
+		End If
+		If tlsIndex <> 0 And tlsIndex <> &hffffffff Then
+			TlsFree(tlsIndex)
+		End If
+'		If hmodComctl <> 0 Then
+'			FreeLibrary(hmodComctl)
+'		End If
+		If PropertyInstance <> 0 Then
+			GlobalDeleteAtom(PropertyInstance)
+		End If
+	End Sub
+
 End Class
 
-Namespace Detail
-Class _System_ControlIinitializer
-Public
-	Sub _System_ControlIinitializer(hinst As HINSTANCE)
-		Control.Initialize(hinst)
-	End Sub
-
-	Sub ~_System_ControlIinitializer()
-		Control.Uninitialize()
-	End Sub
-End Class
-
-#ifndef _SYSTEM_NO_INITIALIZE_CONTROL_
-Dim _System_ControlInitializer As _System_ControlIinitializer(GetModuleHandle(0))
-#endif '_SYSTEM_NO_INITIALIZE_CONTROL_
-
-End Namespace 'Detail
-
-Class Form
+Class Form '仮
 	Inherits Control
 Protected
@@ -294,10 +422,9 @@
 		End With
 	End Sub
-Public '仮
+Public 
+
 	Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
 		WndProc = 0
 		Select Case msg
-			Case WM_DESTROY
-				PostQuitMessage(0)
 			Case Else
 				WndProc = Super.WndProc(msg, wp, lp)
@@ -311,4 +438,5 @@
 End Namespace 'ActiveBasic
 
+
 '----------
 'テスト実行用
@@ -316,17 +444,40 @@
 Imports ActiveBasic.Windows.UI.Forms
 
-Class Bar
-Public
-Static Sub PaintDCEvent(sender As Object, et As PaintDCEventArgs) 
-	Dim e = et As PaintDCEventArgs
-	TextOut(e.Handle, 10, 10, "Hello, world", 12)
-End Sub
+'OleInitialize()
+Control.Initialize(GetModuleHandle(0))
+
+Class MyForm
+	Inherits Form
+Public
+	Sub NcDestory(sender As Object, et As EventArgs)
+		PostQuitMessage(0)
+	End Sub
 End Class
 
-Dim f = New Form
+Dim f = New MyForm
 f.Create()
-Dim v = New PaintDCEventHandler(AddressOf (Bar.PaintDCEvent))
-f.AddPaintDC(v)
-f.Handle.Show(SW_SHOW)
-
-MessageBox(0, "hello", "", 0)
+Dim h = New MessageEventHandler(AddressOf (f.NcDestory))
+f.AddMessageEvent(WM_NCDESTROY, h)
+ShowWindow(f.Handle, SW_SHOW)
+
+Dim m As MSG
+Do
+	Dim ret = GetMessage(m, 0, 0, 0)
+	If ret = 0 Then
+		Exit Do
+	ElseIf ret = -1 Then
+		ExitProcess(-1)
+	End If
+
+	TranslateMessage(m)
+	DispatchMessage(m)
+Loop
+
+f = Nothing
+System.GC.Collect()
+
+Control.Uninitialize()
+'OleUninitialize()
+
+End
+
