'prompt.sbp


#ifndef _INC_PROMPT
#define _INC_PROMPT


#require <api_imm.sbp>
#require <Classes/System/Math.ab>

Dim _PromptSys_hWnd As HWND
Dim _PromptSys_dwThreadID As DWord
Dim _PromptSys_bInitFinish As BOOL

'text
Type _PromptSys_CharacterInformation
	ForeColor As COLORREF
	BackColor As COLORREF
	StartPos As Long
End Type

Type _PromptSys_LineInformation
	Length As Long
	Text As *Char
	CharInfo As *_PromptSys_CharacterInformation
End Type

Dim _PromptSys_LogFont As LOGFONTA 'LOGFONT
Dim _PromptSys_hFont As HFONT
Dim _PromptSys_FontSize As SIZE
Dim _PromptSys_InputStr[255] As Char
Dim _PromptSys_InputLen As Long
Dim _PromptSys_KeyChar As Byte
Dim _PromptSys_CurPos As POINTAPI
Dim _PromptSys_TextLine[100] As _PromptSys_LineInformation
Dim _PromptSys_NowTextColor As COLORREF
Dim _PromptSys_NowBackColor As COLORREF
Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION


_PromptSys_InputLen = -1

'graphic
Dim _PromptSys_hBitmap As HBITMAP
Dim _PromptSys_hMemDC As HDC
Dim _PromptSys_ScreenSize As SIZE
Dim _PromptSys_GlobalPos As POINTAPI

CreateEvent(0, FALSE, FALSE, 0)
_PromptSys_bInitFinish = 0
CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID)
Do
	Sleep(20)
Loop Until _PromptSys_bInitFinish

Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
	Dim i As Long, i2 As Long, i3 As Long

	Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT

	'Scroll
	Dim rc As RECT
	GetClientRect(_PromptSys_hWnd, rc)
	While (_PromptSys_CurPos.y+1) * _PromptSys_FontSize.cy > rc.bottom and _PromptSys_CurPos.y > 0
		_System_free(_PromptSys_TextLine[0].Text)
		_System_free(_PromptSys_TextLine[0].CharInfo)
		For i = 0 To 100 - 1
			_PromptSys_TextLine[i].Length = _PromptSys_TextLine[i+1].Length
			_PromptSys_TextLine[i].Text = _PromptSys_TextLine[i+1].Text
			_PromptSys_TextLine[i].CharInfo = _PromptSys_TextLine[i+1].CharInfo
		Next
		_PromptSys_TextLine[100].Length = 0
		_PromptSys_TextLine[100].Text = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextLine[100].CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
		_PromptSys_CurPos.y--

		'Redraw
		StartLine = -1
	Wend

	i = 0' : Debug
	While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
		If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
			Dim currentLineCharInfo = _PromptSys_TextLine[i].CharInfo

			Dim sz As SIZE
			i3 = lstrlen(_PromptSys_TextLine[i].Text) '_PromptSys_TextLine[i].Length
			If i3 <> 0 Then
				OutputDebugString(Str$(i3) + ":" + Str$(_PromptSys_TextLine[i].Length) + Ex"\r\n")
			End If
			GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)

			BitBlt(hDC,_
				sz.cx, i * _PromptSys_FontSize.cy, _
				rc.right, _PromptSys_FontSize.cy, _
				_PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)

			While i2 < i3
				SetTextColor(hDC, currentLineCharInfo[i2].ForeColor)
				If currentLineCharInfo[i2].BackColor = -1 Then
					SetBkMode(hDC, TRANSPARENT)
				Else
					SetBkMode(hDC, OPAQUE)
					SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
				End If

				Dim tempLen As Long
				If _System_IsDoubleUnitChar(_PromptSys_TextLine[i].Text[i2], _PromptSys_TextLine[i].Text[i2+1]) Then
					tempLen = 2
				Else
					tempLen = 1
				End If
				With _PromptSys_FontSize
					TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]), tempLen)
				End With
				i2 += tempLen
			Wend
		End If

		i++
	Wend

	SelectObject(hDC, hOldFont)
End Sub

Sub PRINT_ToPrompt(buf As String)
	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
	With _PromptSys_CurPos
		Dim hdc = GetDC(_PromptSys_hWnd)
		Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
		Dim StartLine As Long : StartLine = .y
		Dim bufLen = buf.Length
		Dim doubleUnitChar = False As Boolean
		'Addition
		Dim i2 = 0 As Long, i3 As Long' : Debug
		For i2 = 0 To ELM(bufLen)
			If buf[i2] = &h0d Then 'CR \r
				_PromptSys_TextLine[.y].Length = .x
				.x = 0
			ElseIf buf[i2] = &h0a Then 'LF \n
				_PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)
				.y++
			Else
				Dim currentLineCharInfo = _PromptSys_TextLine[.y].CharInfo As *_PromptSys_CharacterInformation
				_PromptSys_TextLine[.y].Text[.x] = buf[i2]
				currentLineCharInfo[.x].ForeColor = _PromptSys_NowTextColor
				currentLineCharInfo[.x].BackColor = _PromptSys_NowBackColor

				If buf[i2] = &h09 Then 'tab
					Dim tabStop = _PromptSys_FontSize.cx * 8
					currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + _
						tabStop - currentLineCharInfo[.x].StartPos Mod tabStop
				Else
					If doubleUnitChar <> False Then
						doubleUnitChar = False
						currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos
					Else
						Dim sz As SIZE
						Dim charLen As Long
						If _System_IsDoubleUnitChar(buf[i2], buf[i2 + 1]) Then
							charLen = 2
							doubleUnitChar = True
						Else
							charLen = 1
						EndIf
						GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]), charLen, sz)
						currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
/*
						Dim buf[1023] As Char
						wsprintf(buf, Ex"%d %d\r\n", currentLineCharInfo[.x + 1].StartPos, currentLineCharInfo[.x].StartPos + sz.cx)
						OutputDebugString(buf)
*/
					End If
				End If
				.x++
			End If
		Next
		_PromptSys_TextLine[.y].Length = Math.Max(_PromptSys_TextLine[.y].Length, .x)

		'Draw the text buffer added
		DrawPromptBuffer(hdc, StartLine, .y)
		SelectObject(hdc, hOldFont)
		ReleaseDC(_PromptSys_hWnd, hdc)
	End With
	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
End Sub

Function PromptProc(hWnd As HWND, message As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT
	Select Case message
		Case WM_CREATE
			Return _PromptWnd_OnCreate(hWnd, ByVal lParam As *CREATESTRUCT)
		Case WM_PAINT
			_PromptWnd_OnPaint(hWnd)
		Case WM_SETFOCUS
			_PromptWnd_OnSetFocus(hWnd, wParam As HWND)
		Case WM_KILLFOCUS
			_PromptWnd_OnKillForcus(hWnd, wParam As HWND)
		Case WM_KEYDOWN
			_PromptWnd_OnKeyDown(wParam As DWord, LOWORD(lParam) As DWord, HIWORD(lParam) As DWord)
		Case WM_CHAR
			_PromptWnd_OnChar(hWnd, wParam, lParam)
		Case WM_IME_COMPOSITION
			Return _PromptWnd_OnImeCompostion(hWnd, wParam, lParam)
		Case WM_DESTROY
			_PromptWnd_OnDestroy(hWnd)
		Case Else
			PromptProc = DefWindowProc(hWnd, message, wParam, lParam)
			Exit Function
	End Select
	PromptProc = 0
End Function

Function _PromptWnd_OnCreate(hwnd As HWND, ByRef cs As CREATESTRUCT) As LRESULT
	Dim hdc = GetDC(hwnd)
	With _PromptSys_ScreenSize
		_PromptSys_hBitmap = CreateCompatibleBitmap(hdc, .cx, .cy)
	End With
	_PromptSys_hMemDC = CreateCompatibleDC(hdc)
	SelectObject(_PromptSys_hMemDC, _PromptSys_hBitmap)

	'Initialize for Win9x
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
	With _PromptSys_ScreenSize
		PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
	End With
	SelectObject(_PromptSys_hMemDC, hOldBrush)

	Dim tm As TEXTMETRIC
	Dim hOldFont = SelectObject(_PromptSys_hMemDC, _PromptSys_hFont) As HFONT
	GetTextMetrics(_PromptSys_hMemDC, tm)
	SelectObject(_PromptSys_hMemDC, hOldFont)
	With _PromptSys_FontSize
		.cx = tm.tmAveCharWidth
		.cy = tm.tmHeight
	End With

	ReleaseDC(hwnd, hdc)

	_PromptWnd_OnCreate = 0
End Function

Sub _PromptWnd_OnPaint(hwnd As HWND)
	Dim ps As PAINTSTRUCT
	Dim hdc = BeginPaint(hwnd, ps)
'	With _PromptSys_ScreenSize
'		BitBlt(hdc, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
	With ps.rcPaint
		BitBlt(hdc, .left, .top, .right - .left, .bottom - .top, _PromptSys_hMemDC, .left, .top, SRCCOPY)
	End With
	DrawPromptBuffer(hdc, -1, 0)
	EndPaint(hwnd, ps)

	_PromptSys_bInitFinish = TRUE
End Sub

Sub _PromptWnd_OnSetFocus(hwnd As HWND, hwndOldFocus As HWND)
	If _PromptSys_InputLen <> -1 Then
		Dim himc = ImmGetContext(hwnd)
		If himc Then
			Dim CompForm As COMPOSITIONFORM
			With CompForm
				.dwStyle = CFS_POINT
				.ptCurrentPos.x = _PromptSys_CurPos.x * _PromptSys_FontSize.cx
				.ptCurrentPos.y = _PromptSys_CurPos.y * _PromptSys_FontSize.cy
			End With
			ImmSetCompositionWindow(himc, CompForm)
			ImmSetCompositionFontA(himc, _PromptSys_LogFont)
		End If
		ImmReleaseContext(hwnd, himc)

		CreateCaret(hwnd, 0, 9, 6)
		SetCaretPos(_PromptSys_CurPos.x * _PromptSys_FontSize.cx, (_PromptSys_CurPos.y + 1) * _PromptSys_FontSize.cy - 7)
		ShowCaret(hwnd)
	End If
End Sub

Sub _PromptWnd_OnKillForcus(hwnd As HWND, hwndNewFocus As HWND)
	HideCaret(hwnd)
	DestroyCaret()
End Sub

Sub _PromptWnd_OnKeyDown(vk As DWord, repeat As DWord, flags As DWord)
	If _PromptSys_InputLen = -1 Then
		_PromptSys_KeyChar = vk As Byte
	End If
End Sub

Sub _PromptWnd_OnDestroy(hwnd As HWND)
	DeleteDC(_PromptSys_hMemDC)
	DeleteObject(_PromptSys_hBitmap)

	PostQuitMessage(0)
End Sub

Sub _PromptWnd_OnChar(hwnd As HWND, wParam As WPARAM, lParam As LPARAM)
	Dim TempStr As String
	If _PromptSys_InputLen <> -1 Then
		If wParam = VK_BACK Then
			If _PromptSys_InputLen Then
				_PromptSys_InputLen--
				_PromptSys_InputStr[_PromptSys_InputLen] = 0

				_PromptSys_CurPos.x--
				With _PromptSys_CurPos
					_PromptSys_TextLine[.y].Text[.x] = 0
				End With
			End If
		ElseIf wParam = VK_RETURN Then
			_PromptSys_InputStr[_PromptSys_InputLen] = 0
			_PromptSys_InputLen = -1
			TempStr = Ex"\r\n"
		ElseIf wParam = &H16 Then
			'Paste Command(Use Clippboard)
			OpenClipboard(hwnd)
			Dim hGlobal = GetClipboardData(CF_TEXT) As HGLOBAL
			If hGlobal = 0 Then Exit Sub
			Dim pTemp = GlobalLock(hGlobal) As PCSTR
#ifdef UNICODE 'A版ウィンドウプロシージャ用
			Dim tempSizeA = lstrlenA(pTemp)
			Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, 0, 0) + 1
			TempStr = ZeroString(tempSizeW)
			MultiByteToWideChar(CP_ACP, 0, pTemp, tempSizeA, StrPtr(TempStr), tempSizeW)
#else
			TempStr = ZeroString(lstrlen(pTemp) + 1)
			lstrcpy(StrPtr(TempStr), pTemp)
#endif
			memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), TempStr.Chars, SizeOf (Char) * TempStr.Length)
			_PromptSys_InputLen += TempStr.Length

			GlobalUnlock(hGlobal)
			CloseClipboard()
		Else
			_PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte
			_PromptSys_InputLen++

			TempStr.ReSize(1)
			TempStr[0] = wParam As Char
		End If

		SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
		PRINT_ToPrompt(TempStr)
		SendMessage(hwnd, WM_SETFOCUS, 0, 0)
	End If
End Sub

Function _PromptWnd_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT
	If (lp And GCS_RESULTSTR) <> 0 Then
		Dim himc = ImmGetContext(hwnd)
		If himc = 0 Then
			'Debug
			Return 0
		End If
		Dim size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
		Dim str = _System_malloc(size) As PTSTR
		If str = 0 Then
			'Debug
			Return 0
		End If
		ImmGetCompositionString(himc, GCS_RESULTSTR, str, size)
		ImmReleaseContext(hwnd, himc)

		memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size)
		_PromptSys_InputLen += size

		Dim tempStr As String(str, size \ SizeOf (Char))
		_System_free(str)

		SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
		PRINT_ToPrompt(tempStr)
		SendMessage(hwnd, WM_SETFOCUS, 0, 0)

		_PromptWnd_OnImeCompostion = 0
	Else
		_PromptWnd_OnImeCompostion = DefWindowProc(hwnd, WM_IME_COMPOSITION, wp, lp)
	End If
End Function

Function PromptMain(dwData As Long) As Long
	Dim i As Long

	'Allocate
	For i = 0 To 100
		With _PromptSys_TextLine[i]
			.Length = 0
			.Text = _System_calloc(SizeOf (Char) * 255)
			.CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255)
		End With
	Next

	'Current Colors initialize
	_PromptSys_NowTextColor = RGB(255, 255, 255)
	_PromptSys_NowBackColor = RGB(0, 0, 0)

	'Setup
	With _PromptSys_ScreenSize
		.cx = GetSystemMetrics(SM_CXSCREEN)
		.cy = GetSystemMetrics(SM_CYSCREEN)
	End With

	'LogFont initialize
	With _PromptSys_LogFont
		.lfHeight = -16
		.lfWidth = 0
		.lfEscapement = 0
		.lfOrientation = 0
		.lfWeight = 0
		.lfItalic = 0
		.lfUnderline = 0
		.lfStrikeOut = 0
		.lfCharSet = SHIFTJIS_CHARSET
		.lfOutPrecision = OUT_DEFAULT_PRECIS
		.lfClipPrecision = CLIP_DEFAULT_PRECIS
		.lfQuality = DEFAULT_QUALITY
		.lfPitchAndFamily = FIXED_PITCH
#ifdef UNICODE
		WideCharToMultiByte(CP_ACP, 0, "ＭＳ 明朝", 5, .lfFaceName, LF_FACESIZE, 0, 0)
#else
		lstrcpy(.lfFaceName, "ＭＳ 明朝")
#endif
	End With

	_PromptSys_hFont = CreateFontIndirectA(_PromptSys_LogFont)

	'Critical Section
	InitializeCriticalSection(_PromptSys_SectionOfBufferAccess)

	'Regist Prompt Class
	Dim wcl As WNDCLASSEX
	ZeroMemory(VarPtr(wcl), Len(wcl))
	With wcl
		.cbSize = Len(wcl)
		.hInstance = GetModuleHandle(0)
		.style = CS_HREDRAW Or CS_VREDRAW' or CS_DBLCLKS
		.hIcon = LoadImage(0, MAKEINTRESOURCE(IDI_APPLICATION), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
		.hIconSm = LoadImage(0, MAKEINTRESOURCE(IDI_WINLOGO), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HICON
		.hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR
		.lpszClassName = "PROMPT"
		.lpfnWndProc = AddressOf(PromptProc)
		.hbrBackground = GetStockObject(BLACK_BRUSH)
	End With
	Dim atom = RegisterClassEx(wcl)

	'Create Prompt Window
	_PromptSys_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, atom As ULONG_PTR As PCSTR, "BASIC PROMPT",
		WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
		0, 0, wcl.hInstance, 0)
	ShowWindow(_PromptSys_hWnd, SW_SHOW)
	UpdateWindow(_PromptSys_hWnd)

	Dim msg As MSG
	Do
		Dim iResult = GetMessage(msg, 0, 0, 0)
		If iResult = 0 Or iResult = -1 Then Exit Do
		TranslateMessage(msg)
		DispatchMessage(msg)
	Loop

	'強制的に終了する
	ExitProcess(0)

	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)

	For i = 0 to 100
		_System_free(_PromptSys_TextLine[i].Text)
		_System_free(_PromptSys_TextLine[i].CharInfo)
	Next

	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)

	DeleteCriticalSection(_PromptSys_SectionOfBufferAccess)

	ExitProcess(0)
End Function


'----------------------
' Prompt text Commands
'----------------------

Macro CLS()(num As Long)
	Dim i As Long

	'When parameter was omitted, num is set to 1
	If num = 0 Then num = 1

	If num = 1 Or num = 3 Then
		'Clear the text screen
		For i = 0 To 100
			With _PromptSys_TextLine[i]
				.Text[0] = 0 '_System_FillChar(_PromptSys_TextLine[i].Text, -1 As Char, 0)
				.Length = 0
			End With
		Next
		With _PromptSys_CurPos
			.x = 0
			.y = 0
		End With
	End If

	If num = 2 Or num = 3 Then
		'Clear the graphics screen
		Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH))
		With _PromptSys_ScreenSize
			PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
		End With
		SelectObject(_PromptSys_hMemDC, hOldBrush)
	End If

	'Redraw
	InvalidateRect(_PromptSys_hWnd, ByVal 0, 0)
End Macro

Macro COLOR(TextColorCode As Long)(BackColorCode As Long)
	_PromptSys_NowTextColor = GetBasicColor(TextColorCode)
	If BackColorCode = -1 Then
		_PromptSys_NowBackColor = -1
	Else
		_PromptSys_NowBackColor = GetBasicColor(BackColorCode)
	End If
End Macro

'---------- Defined in "command.sbp" ----------
'Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr
'Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord
'----------------------------------------------
Sub INPUT_FromPrompt(ShowStr As String)
	Dim i As Long ,i2 As Long, i3 As Long
	Dim buf As String

*InputReStart

	PRINT_ToPrompt(ShowStr)

	'Input by keyboard
	_PromptSys_InputLen = 0
	SendMessage(_PromptSys_hWnd, WM_SETFOCUS, 0, 0)
	While _PromptSys_InputLen <> -1
		Sleep(10)
	Wend
	SendMessage(_PromptSys_hWnd, WM_KILLFOCUS, 0, 0)

	'Set value to variable
	i = 0
	i2 = 0
	buf = ZeroString(lstrlen(_PromptSys_InputStr))
	While 1
		i3 = 0
		While 1
			If _PromptSys_InputStr[i2] = &h2c Then
				buf.Chars[i3] = 0
				Exit While
			End If

			buf.Chars[i3] = _PromptSys_InputStr[i2]

			If _PromptSys_InputStr[i2] = 0 Then Exit While

			i2++
			i3++
		Wend

		_System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buf, i3)

		i++
		If _System_InputDataPtr[i] = 0 and _PromptSys_InputStr[i2] = &h2c Then 'Asc(",")
			PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
			Goto *InputReStart
		ElseIf _PromptSys_InputStr[i2] = 0 Then
			If _System_InputDataPtr[i]<>0 Then
				PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
				Goto *InputReStart
			Else
				Exit While
			End If
		End If

		i2++
	Wend
End Sub

Sub PRINTUSING_ToPrompt(UsingStr As String)
	PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
End Sub

Macro LOCATE(x As Long, y As Long)
	If x < 0 Then x = 0
	If y < 0 Then y = 0
	If y > 100 Then y = 100
	With _PromptSys_CurPos
		.x = x
		.y = y
	End With

	Dim i = _PromptSys_TextLine[y].Length
	If i < x Then
		_System_FillChar(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20) 'Asc(" ")
		Dim i2 As Long
		For i2 = i To ELM(x)
			_PromptSys_TextLine[y].CharInfo[i2].BackColor = -1
		Next
		_PromptSys_TextLine[y].Length = x
	End If
End Macro


'-------------------
' Graphics Commands
'-------------------

Macro CIRCLE(x As Long , y As Long, radius As Long)(ColorCode As Long, StartPos As Double, EndPos As Double, Aspect As Double, bFill As Long, BrushColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Circle (x, y), radius [, color] [, start] [, end] [, aspect] [, f] [, color2]

	Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

	Dim hPen = CreatePen(PS_SOLID,1,GetBasicColor(ColorCode))
	Dim hBrush As HBRUSH
	If bFill Then
		hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
	Else
		hBrush = GetStockObject(NULL_BRUSH)
	End If

	Dim hDC = GetDC(_PromptSys_hWnd)
	Dim hOldPenDC = SelectObject(hDC, hPen)
	Dim hOldBrushDC = SelectObject(hDC, hBrush)
	Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)

	Dim radi2 As Long
	If Aspect<1 Then
		radi2=(CDbl(radius)*Aspect) As Long
	Else
		radi2=radius
		radius=(CDbl(radius)/Aspect) As Long
	End If

	If StartPos=0 And EndPos=0 Then
		Ellipse(hDC,x-radius,y-radi2,x+radius,y+radi2)
		Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
	Else
		Dim sw As Long
		StartPos *=StartPos
		EndPos *=EndPos

		If StartPos<0 Or EndPos<0 Then
			sw=1
		Else
			sw=0
		End If

		StartPos = Abs(StartPos)
		EndPos = Abs(EndPos)

		If StartPos<=78.5 Then
			i1=78
			i2=Int(StartPos)
		ElseIf StartPos<=235.5 Then
			StartPos -= 78.5
			i1=78-Int(StartPos)
			i2=78
		ElseIf StartPos<=392.5 Then
			StartPos -= 235.5
			i1=-78
			i2=78-Int(StartPos)
		ElseIf StartPos<=549.5 Then
			StartPos -= 392.5
			i1=-78+Int(StartPos)
			i2=-78
		ElseIf StartPos<=628 Then
			StartPos -= 549.5
			i1=78
			i2=-78+Int(StartPos)
		End If

		If EndPos<=78.5 Then
			i3=78
			i4=Int(EndPos)
		ElseIf EndPos<=235.5 Then
			EndPos -= 78.5
			i3=78-Int(EndPos)
			i4=78
		ElseIf EndPos<=392.5 Then
			EndPos -= 235.5
			i3=-78
			i4=78-Int(EndPos)
		ElseIf EndPos<=549.5 Then
			EndPos -= 392.5
			i3=-78+Int(EndPos)
			i4=-78
		ElseIf EndPos<=628 Then
			EndPos -= 549.5
			i3=78
			i4=-78+Int(EndPos)
		End If

		If sw Then
			Pie(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
			Pie(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
		Else
			Arc(hDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
			Arc(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2,  x+i1,y-i2,x+i3,y-i4)
		End If
	End If

	SelectObject(hDC, hOldPenDC)
	SelectObject(hDC, hOldBrushDC)
	ReleaseDC(_PromptSys_hWnd, hDC)
	SelectObject(_PromptSys_hMemDC, hOldPen)
	SelectObject(_PromptSys_hMemDC, hOldBrush)
	DeleteObject(hPen)
	If bFill Then DeleteObject(hBrush)
End Macro

Macro LINE(sx As Long, sy As Long, bStep As Long, ex As Long, ey As Long)(ColorCode As Long, fType As Long, BrushColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Line (sx,sy)-[STEP](ex,ey),[ColorCode],[B/Bf],[BrushColor]
	Dim temp As Long

	If sx = &H80000000 And sy = &H80000000 Then
		With _PromptSys_GlobalPos
			sx = .x
			sy = .y
		End With
	End If

	If bStep Then
		ex += sx
		ey += sy
	Else
		If fType Then
			'ラインの場合（四角形でない場合）
			If sx>ex Then
				temp=ex
				ex=sx
				sx=temp
			End If
			If sy>ey Then
				temp=ey
				ey=sy
				sy=temp
			End If
		End If
	End If

	Dim hDC = GetDC(_PromptSys_hWnd)
	Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
	Dim hBrush As HBRUSH
	If fType=2 Then
		hBrush = CreateSolidBrush(GetBasicColor(BrushColor))
	Else
		hBrush = GetStockObject(NULL_BRUSH)
	End If

	SelectObject(hDC, hPen)
	SelectObject(hDC, hBrush)
	Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)

	Select Case fType
		Case 0
			'line
			MoveToEx(_PromptSys_hMemDC,sx,sy,ByVal NULL)
			LineTo(_PromptSys_hMemDC,ex,ey)
			SetPixel(_PromptSys_hMemDC,ex,ey,GetBasicColor(ColorCode))
			MoveToEx(hDC,sx,sy,ByVal NULL)
			LineTo(hDC,ex,ey)
			SetPixel(hDC,ex,ey,GetBasicColor(ColorCode))
		Case Else
			'Rectangle
			Rectangle(hDC,sx,sy,ex+1,ey+1)
			Rectangle(_PromptSys_hMemDC,sx,sy,ex+1,ey+1)
	End Select

	ReleaseDC(_PromptSys_hWnd,hDC)
	SelectObject(_PromptSys_hMemDC,hOldPen)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	DeleteObject(hPen)
	If fType = 2 Then DeleteObject(hBrush)
	With _PromptSys_GlobalPos
		.x = ex
		.y = ey
	End With
End Macro

Macro PSET(x As Long, y As Long)(ColorCode As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'PSet (x,y),ColorCode

	Dim hDC = GetDC(_PromptSys_hWnd)
	SetPixel(hDC, x, y, GetBasicColor(ColorCode))
	SetPixel(_PromptSys_hMemDC, x, y, GetBasicColor(ColorCode))
	ReleaseDC(_PromptSys_hWnd, hDC)
	With _PromptSys_GlobalPos
		.x = x
		.y = y
	End With
End Macro

Macro PAINT(x As Long, y As Long, BrushColor As Long)(ByVal LineColor As Long)
	'呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
	'Paint (x,y),BrushColor,LineColor

	Dim hBrush = CreateSolidBrush(GetBasicColor(BrushColor))

	Dim hDC = GetDC(_PromptSys_hWnd)
	Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
	Dim hOldBrushWndDC = SelectObject(hDC, hBrush)

	ExtFloodFill(hDC, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)
	ExtFloodFill(_PromptSys_hMemDC, x, y, GetBasicColor(LineColor), FLOODFILLBORDER)

	ReleaseDC(_PromptSys_hWnd, hDC)
	SelectObject(_PromptSys_hMemDC, hOldBrush)
	SelectObject(hDC, hOldBrushWndDC)
	DeleteObject(hBrush)
End Macro


'-----------
' Functions
'-----------

Function Inkey$() As String
	If _PromptSys_KeyChar=0 Then
		Inkey$=""
	Else
		Inkey$=Chr$(_PromptSys_KeyChar)
	End If
	_PromptSys_KeyChar=0
End Function

Function Input$(length As Long) As String
	Dim i As Long

	If length<=0 Then
		Input$=""
		Exit Function
	End If

	i=0
	While 1
		If _PromptSys_KeyChar Then
			Input$=Input$+Chr$(_PromptSys_KeyChar)
			_PromptSys_KeyChar=0
			i++
			If i >= length Then
				Exit While
			End If
		End If
		Sleep(1)
	Wend
End Function


#endif '_INC_PROMPT