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

#ifndef __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
#define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__

#include <windows/WindowHandle.sbp>
#include <Classes/System/Windows/Forms/misc.ab>
#include <Classes/System/Windows/Forms/CreateParams.ab>
#include <Classes/System/Windows/Forms/Message.ab>
#include <Classes/System/Windows/Forms/PaintEventArgs.ab>
#include <Classes/System/misc.ab>
#include <Classes/System/Math.ab>
#include <Classes/System/Threading/WaitHandle.ab>
#include <Classes/System/Drawing/Color.ab>
#include <Classes/System/Drawing/Point.ab>
#include <Classes/System/Drawing/Size.ab>
#include <Classes/System/Drawing/Rectangle.ab>

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

	Override Function AsyncState() As *IObject
		Return 0
	End Function

	Override Function AsyncWaitHandle() As *WaitHandle
		Return VarPtr(AsyncWaitHandle)
	End Function

	Override Function CompletedSynchronously() As BOOL
		Return FALSE
	End Function

	Override Function IsCompleted() As BOOL
		Return AsyncWaitHandle()->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 WaitHandle
	result As VoidPtr
End Class

Class AsyncInvokeData
Public
	FuncPtr As *Function(p As VoidPtr) As VoidPtr
	Data As *VoidPtr
	AsyncResult As *AsyncResultForInvoke
End Class

Class Control
	Inherits IWin32Window
Public
	'---------------------------------------------------------------------------
	' Public Properties

	Function AllowDrop() As BOOL
	End Function

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

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

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

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

	Const Function Text() As String
		Return text
	End Function

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

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

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

	Const Function Bounds() As Rectangle
		Dim wr As RECT
		wr = wnd.WindowRect
		Dim r As Rectangle(wr)
		Dim parent = Parent
		If parent <> 0 Then
			Return parent->RectangleToClient(r)
		Else
			Return r
		End If
	End Function

	Sub Bounds(ByRef 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
		Dim r As Rectangle(wnd.ClientRect)
		Return r
	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
		Return Left + Width
	End Function

	Const Function Bottom() As Long
		Return Top + Height
	End Function

	Const Function PointToScreen(p As Point) As Point
		wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI)
		Return r
	End Function

	Const Function PointToClient(p As Point) As Point
		wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI)
		Return r
	End Function

	Const Function RectangleToScreen(p As Rectangle) As Rectangle
		wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI)
		Return p
	End Function

	Const Function RectangleToClient(p As Rectangle) As Rectangle
		wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI)
		Return p
	End Function

	Const Function InvokeRequired() As BOOL
		Return wnd.ThreadID <> GetCurrentThreadId()
	End Function

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

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

	Function Parent() As *Control
		Return parent
	End Function

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

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

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

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

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

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

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

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

	Virtual Sub ~Control()
		If wnd.IsWindow Then
			wnd.Destroy() ' 暫定
		End If
	End Sub

	'---------------------------------------------------------------------------
	' Public Methods

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

	' 非同期関数呼出、Controlが作成されたスレッドで関数を実行する。
	' 関数は非同期的に呼び出されるので、BeginInvokeはすぐに制御を戻す。
	' 後にEndInvokeを呼び出すことにより、関数の戻り値を受け取れる。
	' 注意：現状の実装では必ずEndInvokeを呼び出す必要がある。
	Function BeginInvoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As *IAsyncResult
		' EndInvokeがDeleteする
		Dim pAsyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0))
		' OnControlBeginInvokeがDeleteする
		Dim pAsyncInvokeData = New AsyncInvokeData
		With pAsyncInvokeData[0]
			.FuncPtr = pfn
			.Data = p
			.AsyncResult = pAsyncResult
		End With
		wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, pAsyncInvokeData As LPARAM)
		Return pAsyncResult
	End Function

	' BeginInvokeで呼び出した関数の戻り値を受け取る。
	' その関数がまだ終了していない場合、終了するまで待機する。
	Function EndInvoke(ar As *IAsyncResult) As VoidPtr
		ar->WaitHandle->WaitOne()
		Dim arInvoke = ar As *AsyncResultForInvoke
		Dim result = arInvoke->Result
		Delete arInvoke
		Return result
	End Function

	' 与えられたウィンドウハンドルがControl（若しくはその派生クラス）の
	' インスタンスに対応するものであった場合、
	' 元のインスタンスへのポインタを返す。
	' そうでなければヌルポインタを返す。
	Static Function FromHandle(hwnd As HWND) As *Control
		If IsWindow(hwnd) Then
			Dim className[19] As Byte 'Len (WindowClassName)
			GetClassName(hwnd, className, Len (className))
			If memcmp(className, WindowClassName, Len (WindowClassName)) = 0 Then
				Return GetWindowLongPtr(hwnd, GWLP_THIS) As *Control
			End If
		End If
		Return 0 As *Control
	End Function

	Virtual Sub ResetText()
		text = ""
	End Sub

	/*Override*/ Virtual 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()
		wnd.Show(SW_SHOW)
	End Sub

	Sub Update()
		wnd.Update()
	End Sub

Protected
	'---------------------------------------------------------------------------
	' Protected Properties
'	Const Virtual Function CanRaiseEvents() As BOOL
	Virtual Function CreateParams() As *CreateParams
		Return VarPtr(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(ByRef c As Cursor)

	'---------------------------------------------------------------------------
	' Protected Methods
	Virtual Sub CreateHandle()
		Dim createParams = CreateParams()
		TlsSetValue(tlsIndex, VarPtr(This))
		With createParams[0]
			Dim hwndParent = 0 As HWND
			If parent <> 0 Then
				hwndParent = parent->Handle
			End If
			If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, text, .Style, _
				CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
				hwndParent, 0, hInstance, 0) = 0 Then
				' Error
				Dim buf[1023] As Byte
				wsprintf(buf, Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n", GetLastError())
				OutputDebugString(buf)
'				Debug
				ExitThread(0)
			End If
		End With
	End Sub

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

	Virtual Sub WndProc(ByRef m As Message)
		With m
			Select Case .Msg
				Case WM_GETTEXTLENGTH
					.Result = text.Length
				Case WM_GETTEXT
					Dim size = Math.Min(.WParam As ULONG_PTR, text.Length As ULONG_PTR + 1)
					memcpy(.LParam As *Byte, text.StrPtr, size)
					.Result = size
				Case WM_SETTEXT
					text = .LParam As *Byte
				Case WM_ENABLE
					Dim e As EventArgs
					OnEnabledChanged(e)
				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 As *Function(p As VoidPtr) As VoidPtr
					pfn = .LParam As *Function(p As VoidPtr) As VoidPtr
					.Result = pfn(m.WParam As VoidPtr) As LRESULT
				Case WM_CONTROL_BEGININVOKE
					OnControlBeginInvoke(m)
				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(ByRef e As PaintEventArgs) : End Sub
	Virtual Sub OnEnabledChanged(ByRef e As EventArgs) : End Sub
	Virtual Sub OnBackColorChanged(ByRef e As EventArgs) : End Sub
	Virtual Sub OnTextChanged(ByRef e As EventArgs)
		wnd.SetText(text.StrPtr)
	End Sub

Private
	' Member variables
	wnd As 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" As *Byte
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 = WindowClassName
			.hIconSm = 0
		End With
		atom = RegisterClassEx(wcx)
		If atom = 0 Then
			Dim buf[1023] As Byte
			wsprintf(buf, 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 pThis = Control.FromHandle(hwnd) As *Control
		If pThis = 0 Then
			pThis = TlsGetValue(tlsIndex)
			' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
			TlsSetValue(tlsIndex, 0)
			If pThis = 0 Then
				' あってはならない事態
				Debug
				ExitThread(0)
			End If
'			Debug
			pThis->wnd = hwnd
			SetWindowLongPtr(hwnd, GWLP_THIS, pThis As LONG_PTR)
		End If
		Dim m As Message
		m = Message.Create(hwnd, msg, wp, lp)
		pThis->WndProc(m)
		Return m.Result
	End Function

	' BeginInvokeが呼ばれたときの処理
	Sub OnControlBeginInvoke(ByRef m As Message)
		Dim data As *AsyncInvokeData
		data = m.LParam As *AsyncInvokeData
		Dim asyncResult As *AsyncResultForInvoke
		asyncResult->Result = data->FuncPtr(data->Data)
		Dim wh = asyncResult->AsyncWaitHandle
		SetEvent(wh->Handle)
		Delete data
	End Sub
End Class

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_

#endif '__SYSTEM_WINDOWS_FORMS_CONTROL_AB__