' Classes/System/Windows/Forms/Control.ab

#ifndef __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
#define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__

#require <Classes/System/Windows/Forms/misc.ab>
#require <Classes/System/Windows/Forms/CreateParams.ab>
#require <Classes/System/Windows/Forms/Message.ab>
#require <Classes/System/Windows/Forms/PaintEventArgs.ab>
#require <Classes/System/misc.ab>
#require <Classes/System/Math.ab>
#require <Classes/System/Threading/WaitHandle.ab>
#require <Classes/System/Drawing/Color.ab>
#require <Classes/System/Drawing/Point.ab>
#require <Classes/System/Drawing/Size.ab>
#require <Classes/System/Drawing/Rectangle.ab>
#require <Classes/System/Runtime/InteropServices/GCHandle.ab>
#require <Classes/ActiveBasic/Windows/WindowHandle.sbp>
#require <Classes/ActiveBasic/Strings/Strings.ab>

Namespace System
Namespace Windows
Namespace Forms

Namespace Detail

TypeDef InvokeProc = *Function(p As VoidPtr) As VoidPtr

Class AsyncResultForInvoke
	Implements System.IAsyncResult
Public
	' Properties
	Sub AsyncResultForInvoke(h As HANDLE)
		waitHandle.Handle = h
	End Sub

	Function AsyncState() As Object
		Return Nothing
	End Function

	Function AsyncWaitHandle() As System.Threading.WaitHandle
		Return waitHandle
	End Function

	Function CompletedSynchronously() As Boolean
		Return False
	End Function

	Function IsCompleted() As Boolean
		Return waitHandle.WaitOne(0, False)
	End Function

	Const Function Result() As VoidPtr
		Return result
	End Function

	Sub Result(r As VoidPtr)
		result = r
	End Sub

Private
	waitHandle As System.Threading.WaitHandle
	result As VoidPtr
End Class

Class AsyncInvokeData
Public
	FuncPtr As InvokeProc
	Data As *VoidPtr
	AsyncResult As AsyncResultForInvoke
End Class

End Namespace 'Detail

Class Control

'	Inherits IWin32Window
Public
	'---------------------------------------------------------------------------
	' Public Properties
	Function AllowDrop() As Boolean
	End Function

	'Anchor
	'AutoScrollOffset 
	'AutoSize
	'BackColor下
	'BackgroundImage
	'BackgroundImageLayout
	'-BindingContext
	'Bottom 下
	'Bounds 下
	'CanFocus
	'CanSelect
	'Capture
	'-CausesValidation
	'CheckForIllegalCrossThreadCalls

	/*Override*/ Function Handle() As HWND
		Return wnd.HWnd
	End Function

	' IDropTargetを実装するのでDragAcceptFiles関数は呼ばない。
	Sub AllowDrop(a As Boolean)
	End Sub

	Const Function Visible() As Boolean
		Return wnd.Visible
	End Function

	Sub Visible(v As Boolean)
		wnd.Visible(v)
	End Sub

	Const Function Text() As String
		Return text
	End Function

	Sub Text(t As String)
		text = t
		Dim e As EventArgs
		OnTextChanged(e)
	End Sub

	Const Function Enabled() As Boolean
		Return wnd.Enabled
	End Function

	Sub Enabled(e As Boolean)
		' OnEnabledChangedはWM_ENABLE経由で呼ばれる
		wnd.Enabled(e)
	End Sub

	Const Function Bounds() As Rectangle
		Dim wr As RECT
		wr = wnd.WindowRect
		Dim r = New Rectangle(wr)
		Dim parent = Parent
		If Object.ReferenceEquals(parent, Nothing) Then
			Return parent->RectangleToClient(r)
		Else
			Return r
		End If
	End Function

	Sub Bounds(r As Rectangle)
		SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All)
	End Sub

	Const Function Location() As Point
		Return Bounds.Location
	End Function

	Sub Location(p As Point)
		SetBoundsCore(p.X, p.Y, 0, 0, BoundsSpecified.Location)
	End Sub

	Const Function Size() As Size
		Return Bounds.Size
	End Function

	Sub Size(s As Size)
		SetBoundsCore(0, 0, s.Width, s.Height, BoundsSpecified.Size)
	End Sub

	Const Function ClientRectangle() As Rectangle
		Return New Rectangle(wnd.ClientRect)
	End Function

	Const Function ClientSize() As Size
		Return ClientRectangle.Size
	End Function

	Const Function Left() As Long
		Dim b = Bounds
		Return b.Left
	End Function

	Sub Left(l As Long)
		SetBoundsCore(l, 0, 0, 0, BoundsSpecified.X)
	End Sub

	Const Function Top() As Long
		Dim b = Bounds
		Return b.Top
	End Function

	Sub Top(t As Long)
		SetBoundsCore(0, t, 0, 0, BoundsSpecified.Y)
	End Sub

	Const Function Width() As Long
		Dim b = Bounds
		Return b.Width
	End Function

	Sub Width(w As Long)
		SetBoundsCore(0, 0, w, 0, BoundsSpecified.Width)
	End Sub

	Const Function Height() As Long
		Dim b = Bounds
		Return b.Height
	End Function

	Sub Height(h As Long)
		SetBoundsCore(0, 0, 0, h, BoundsSpecified.Height)
	End Sub

	Const Function Right() As Long
		Dim b = Bounds
		Return b.Left + b.Width
	End Function

	Const Function Bottom() As Long
		Dim b = Bounds
		Return b.Top + b.Height
	End Function
/*
	Const Function PointToScreen(p As Point) As Point
		PointToScreen = New Point
		PointToScreen.X = p.X
		PointToScreen.Y = p.Y
		wnd.ClientToScreen(ByVal ObjPtr(PointToScreen) As *POINTAPI)
	End Function

	Const Function PointToClient(p As Point) As Point
		PointToScreen = New Point
		PointToClient.X = p.X
		PointToClient.Y = p.Y
		wnd.ScreenToClient(ByVal ObjPtr(PointToClient) As *POINTAPI)
	End Function
*/
	Const Function RectangleToScreen(r As Rectangle) As Rectangle
		Dim rc = r.ToRECT
		wnd.ClientToScreen(rc)
		Return New Rectangle(rc)
	End Function

	Const Function RectangleToClient(r As Rectangle) As Rectangle
		Dim rc = r.ToRECT()
		wnd.ScreenToClient(rc)
		Return New Rectangle(rc)
	End Function

	Const Function InvokeRequired() As Boolean
		Return wnd.ThreadId <> GetCurrentThreadId()
	End Function

	Const Virtual Function BackColor() As Color
		Return bkColor
	End Function

	Virtual Sub BackColor(c As Color)
		c = bkColor
		OnBackColorChanged(New EventArgs)
	End Sub

	Function Parent() As Control
		Return parent
	End Function

	Const Function IsHandleCreated() As Boolean
		Return wnd.HWnd <> 0 Or IsWindow(wnd.HWnd) <> FALSE
	End Function

	Static Function DefaultBackColor() As Color
		Return Color.FromArgb(255, 255, 255)
	End Function

	'---------------------------------------------------------------------------
	' Constractors

	Sub Control()
		Debug
		Dim sz = DefaultSize()
		Control("", 100, 100, sz.Width, sz.Height)
	End Sub

	Sub Control(text As String)
		Dim sz = DefaultSize()
		Control(text, 100, 100, sz.Width, sz.Height)
	End Sub

	Sub Control(parent As Control, text As String)
		Dim sz = DefaultSize()
		Control(parent, text, 100, 100, sz.Width, sz.Height)
	End Sub

	Sub Control(text As String, left As Long, top As Long, width As Long, height As Long)
		This.text = text
		bkColor = DefaultBackColor
	End Sub

	Sub Control(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long)
		This.parent = parent
		Control(text, left, top, width, height)
	End Sub

	'---------------------------------------------------------------------------
	' Destractor

	Virtual Sub ~Control()
		If Not Object.ReferenceEquals(wnd, Nothing) Then
			If wnd.IsWindow Then
				wnd.Destroy() ' 暫定
			End If
		End If
	End Sub

	'---------------------------------------------------------------------------
	' Public Methods
/*
	' 同期関数呼出、Controlが作成されたスレッドで関数を実行する。
	' 関数は同期的に呼び出されるので、関数が終わるまでInvokeは制御を戻さない。
	Function Invoke(pfn As System.Windows.Forms.Detail.InvokeProc, p As VoidPtr) As VoidPtr
		Return wnd.SendMessage(WM_CONTROL_INVOKE, p As WPARAM, pfn As LPARAM) As VoidPtr
	End Function

	' 非同期関数呼出、Controlが作成されたスレッドで関数を実行する。
	' 関数は非同期的に呼び出されるので、BeginInvokeはすぐに制御を戻す。
	' 後にEndInvokeを呼び出すことにより、関数の戻り値を受け取れる。
	Function BeginInvoke(pfn As System.Windows.Forms.Detail.InvokeProc, p As VoidPtr) As System.IAsyncResult
		' EndInvokeがDeleteする
		Dim asyncResult = New System.Windows.Forms.Detail.AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0))
		Dim asyncInvokeData = New System.Windows.Forms.Detail.AsyncInvokeData
		With asyncInvokeData
			.FuncPtr = pfn
			.Data = p
			.AsyncResult = asyncResult
		End With
		Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(asyncInvokeData)
		wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch))
		Return asyncResult
	End Function

	' BeginInvokeで呼び出した関数の戻り値を受け取る。
	' その関数がまだ終了していない場合、終了するまで待機する。
	Function EndInvoke(ar As System.IAsyncResult) As VoidPtr
		ar.WaitHandle.WaitOne()
		Dim arInvoke = ar As System.Windows.Forms.Detail.AsyncResultForInvoke
		Return arInvoke.Result
	End Function
*/
	' 与えられたウィンドウハンドルがControl（若しくはその派生クラス）の
	' インスタンスに対応するものであった場合、
	' 元のインスタンスを返す。
	' そうでなければNothingを返す。
	Static Function FromHandle(hwnd As HWND) As Control
		If IsWindow(hwnd) Then
			If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
				Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS))
				Return gch.Target As Control
			End If
		End If
		Return Nothing As Control
	End Function

	Virtual Sub ResetText()
		text = ""
	End Sub

	Override Function ToString() As String
		Return text
	End Function

	' Wrapper Methods
	Sub BringToFront()
		wnd.BringToTop()
	End Sub

	Sub Hide()
		wnd.Show(SW_HIDE)
	End Sub

	Sub Show()
		Debug
		wnd.Show(SW_SHOW)
	End Sub

	Sub Update()
		wnd.Update()
	End Sub

	Sub CreateControl()
		CreateHandle() '暫定
	End Sub

Protected

	'---------------------------------------------------------------------------
	' Protected Properties
'	Const Virtual Function CanRaiseEvents() As Boolean
	Virtual Function CreateParams() As CreateParams
		Return createParams
	End Function
'	Virtual Function DefaultCursor() As Cursor

	Virtual Function DefaultSize() As Size
		Dim s As Size(300, 300)
		Return s
	End Function

'	Function FontHeight() As Long
'	Sub FontHeight(h As Long)

'	Const Virtual Function Cursor() As Cursor
'	Virtual Sub Cursor(c As Cursor)

	'---------------------------------------------------------------------------
	' Protected Methods
	Virtual Sub CreateHandle()
		Dim createParams = CreateParams()
		Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(This)
		TlsSetValue(tlsIndex, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch) As VoidPtr)
		With createParams
			Dim hwndParent = 0 As HWND
			If Not Object.ReferenceEquals(parent, Nothing) Then
				hwndParent = parent.Handle
			End If
			Dim pText As PCTSTR
			If String.IsNullOrEmpty(text) Then
				pText = "" As PCTSTR
			Else
				pText = ToTCStr(text)
			End If

			If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, pText, .Style, _
				CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
				hwndParent, 0, hInstance, 0) = 0 Then
				' Error
				Dim buf[1023] As TCHAR
				wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError())
				OutputDebugString(buf)
'				Debug
				ExitThread(0)
			End If
		End With
		gch.Free()
	End Sub

	Virtual Sub DefWndProc(m As Message)
		m.Result = DefWindowProc(m.HWnd, m.Msg, m.WParam, m.LParam)
	End Sub

	Virtual Sub WndProc(m As Message)
		With m
			Select Case .Msg
				Case WM_GETTEXTLENGTH
					.Result = text.Length 'ToDo: Unicode対応
				Case WM_GETTEXT
					Dim size = System.Math.Min(.WParam As SIZE_T, (text.Length + 1) As SIZE_T)
					ActiveBasic.Strings.ChrCopy(.LParam As PCTSTR, ToTCStr(text), size)
					.Result = size
				Case WM_SETTEXT
					text = New String(.LParam As PCTSTR)
				Case WM_ENABLE
					OnEnabledChanged(System.EventArgs.Empty)
				Case WM_ERASEBKGND
					' OnPaintBackgroundに移すべき
					Dim hdc = .WParam As HDC
					Dim hbr = CreateSolidBrush(bkColor.ToCOLORREF())
					Dim hbrOld = SelectObject(hdc, hbr)
					Dim rc = wnd.ClientRect
					Rectangle(hdc, rc.left, rc.top, rc.right, rc.bottom)
					SelectObject(hdc, hbrOld)
					DeleteObject(hbr)
				Case WM_CONTROL_INVOKE
					Dim pfn = .LParam As System.Windows.Forms.Detail.InvokeProc
					.Result = pfn(m.WParam As VoidPtr) As LRESULT
				Case WM_CONTROL_BEGININVOKE
					OnControlBeginInvoke(m)
				Case WM_CREATE
					OnHandleCreated(System.EventArgs.Empty)
				Case WM_DESTROY
					OnHandleDestroyed(System.EventArgs.Empty)
				Case Else
					DefWndProc(m)
			End Select
		End With
	End Sub

	Virtual Sub SetClientSizeCore(x As Long, y As Long)
		Dim rc As RECT
		With rc
			.left = 0
			.top = 0
			.right = x
			.bottom = y
		End With
		Dim hasMenu = FALSE As BOOL
		If wnd.Parent As HWND = 0 Then
			If wnd.Menu <> 0 Then
				hasMenu = TRUE
			End If
		End If
		AdjustWindowRectEx(rc, wnd.Style, hasMenu, wnd.ExStyle)
		wnd.Move(rc)
	End Sub

	Virtual Sub SetBoundsCore(x As Long, y As Long, width As Long, height As Long, bs As BoundsSpecified)
'		If Not (bs As DWord And BoundsSpecified.X As DWord) Then
			x = Left
'		End If
'		If Not (bs As DWord And BoundsSpecified.Y As DWord) Then
			y = Right
'		End If
'		If Not (bs As DWord And BoundsSpecified.Width As DWord) Then
			width = Width
'		End If
'		If Not (bs As DWord And BoundsSpecified.Height As DWord) Then
			height = Height
'		End If
		wnd.Move(x, y, width, height)
	End Sub

	Virtual Sub NotifyInvalidate(r As Rectangle)
		Dim rc As RECT
		rc = r.ToRECT()
		wnd.InvalidateRect(rc)
	End Sub

	Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub
	Virtual Sub OnEnabledChanged(e As System.EventArgs) : End Sub
	Virtual Sub OnBackColorChanged(e As System.EventArgs) : End Sub
	Virtual Sub OnHandleCreated(e As System.EventArgs) : End Sub
	Virtual Sub OnHandleDestroyed(e As System.EventArgs) : End Sub
	Virtual Sub OnTextChanged(e As System.EventArgs)
		wnd.SetText(ToTCStr(text))
	End Sub

Private
	' Member variables
	wnd As ActiveBasic.Windows.WindowHandle
	text As String
	parent As Control
	bkColor As Color

	Static createParams As CreateParams

	'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
	Static tlsIndex As DWord

	Static hInstance As HINSTANCE
	Static atom As ATOM

	Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord
	Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord

	Static Const WindowClassName = "ActiveBasic Control"
Public
	Static Sub Initialize(hinst As HINSTANCE)
		tlsIndex = TlsAlloc()
		hInstance = hinst

		Dim wcx As WNDCLASSEX
		With wcx
			.cbSize = Len (wcx)
			.style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
			.lpfnWndProc = AddressOf (WndProcFirst)
			.cbClsExtra = 0
			.cbWndExtra = SizeOf (LONG_PTR) * 2
			.hInstance = hinst
			.hIcon = 0
			.hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
			.hbrBackground = 0
			.lpszMenuName = 0
			.lpszClassName = ToTCStr(WindowClassName)
			.hIconSm = 0
		End With
		atom = RegisterClassEx(wcx)
		If atom = 0 Then
			Dim buf[1023] As TCHAR
			wsprintf(buf, ToTCStr(Ex"Control: RegisterClasseEx failed. Error code: &h%08X\r\n"), GetLastError())
			OutputDebugString(buf)
			Debug
			ExitThread(0)
		End If

		With createParams
			' 値は暫定的なもの
			.Style = WS_OVERLAPPEDWINDOW
			.ExStyle = WS_EX_APPWINDOW
		End With
	End Sub

	Static Sub Uninitialize()
		UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance)
		TlsFree(tlsIndex)
	End Sub
Private
	Static Const GWLP_THIS = SizeOf (LONG_PTR) * 0 As Long
	Static Const GWLP_TAG = SizeOf (LONG_PTR) * 1 As Long

	' Windowsから呼ばれるウィンドウプロシージャ。WndProc
	Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
		Dim rThis = Control.FromHandle(hwnd) As Control
		If Object.ReferenceEquals(rThis As Object, Nothing) Then
			Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR
			Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue)
			rThis = gch.Target As Control
			' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
			If Object.ReferenceEquals(rThis, Nothing) Then
				' あってはならない事態
				Debug
				ExitThread(-1)
			End If
			rThis.wnd = New ActiveBasic.Windows.WindowHandle(hwnd)
			SetWindowLongPtr(hwnd, GWLP_THIS, gchValue)
		End If

		Dim m = Message.Create(hwnd, msg, wp, lp)
		rThis.WndProc(m)
		Return m.Result
	End Function

	' BeginInvokeが呼ばれたときの処理
	Sub OnControlBeginInvoke(m As Message)
		Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(m.LParam)
		Dim data = gch.Target As System.Windows.Forms.Detail.AsyncInvokeData
		With data
			Dim pfn = .FuncPtr
			.AsyncResult.Result = pfn(.Data)
			SetEvent(.AsyncResult.AsyncWaitHandle.Handle)
		End With
	End Sub
End Class

Namespace Detail
Class _System_ControlIinitializer
Public
	Sub _System_ControlIinitializer(hinst As HINSTANCE)
		System.Windows.Forms.Control.Initialize(hinst)
	End Sub

	Sub ~_System_ControlIinitializer()
		System.Windows.Forms.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

End Namespace 'Forms
End Namespace 'Widnows
End Namespace 'System

#endif '__SYSTEM_WINDOWS_FORMS_CONTROL_AB__