'prompt.sbp


#ifndef _INC_PROMPT
#define _INC_PROMPT


#include <api_imm.sbp>

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

'text
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_Buffer[100] As *Char
Dim _PromptSys_TextColor[100] As *COLORREF
Dim _PromptSys_BackColor[100] As *COLORREF
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


_PromptSys_bInitFinish=0
CreateThread( _
	0,
	0,
	AddressOf(PromptMain) As LPTHREAD_START_ROUTINE,
	0 As VoidPtr,
	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 sz As SIZE
	Dim temporary[2] As Char

	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_Buffer[0])
		_System_free(_PromptSys_TextColor[0])
		_System_free(_PromptSys_BackColor[0])
		For i=0 To 100-1
			_PromptSys_Buffer[i] = _PromptSys_Buffer[i+1]
			_PromptSys_TextColor[i] = _PromptSys_TextColor[i+1]
			_PromptSys_BackColor[i] = _PromptSys_BackColor[i+1]
		Next
		_PromptSys_Buffer[100] = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextColor[100] = _System_calloc(SizeOf(COLORREF) * 255)
		_PromptSys_BackColor[100] = _System_calloc(SizeOf(COLORREF) * 255)

		_PromptSys_CurPos.y--

		'Redraw
		StartLine=-1
	Wend

	i=0
	While i*_PromptSys_FontSize.cy<rc.bottom and i<=100
		If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
			i3 = lstrlen(_PromptSys_Buffer[i])
			GetTextExtentPoint32(hDC, _PromptSys_Buffer[i], i3, sz)

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

			For i2 = 0 To i3-1
				SetTextColor(hDC, _PromptSys_TextColor[i][i2])
				If _PromptSys_BackColor[i][i2] = -1 Then
					SetBkMode(hDC, TRANSPARENT)
				Else
					SetBkMode(hDC, OPAQUE)
					SetBkColor(hDC, _PromptSys_BackColor[i][i2])
				End If

				Dim tempLen As Long
				temporary[0]=_PromptSys_Buffer[i][i2]
#ifdef UNICODE
				If _System_IsSurrogatePair(_PromptSys_Buffer[i][i2], _PromptSys_Buffer[i][i2+1]) Then
#else
				If IsDBCSLeadByte(temporary[0]) Then
#endif
					temporary[1] = _PromptSys_Buffer[i][i2+1]
					temporary[2] = 0
					i2++
					tempLen = 2
				Else
					temporary[1] = 0
					tempLen = 1
				End If
				With _PromptSys_FontSize
					TextOut(hDC, i2 * .cx, i * .cy, temporary, tempLen)
				End With
			Next
		End If

		i++
	Wend

	SelectObject(hDC, hOldFont)
End Sub

Sub PRINT_ToPrompt(buf As String)
	EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
	With _PromptSys_CurPos
		Dim StartLine As Long
		StartLine = .y
		'Addition
		Dim i2 = 0 As Long, i3 As Long
		Do
			If buf[i2] = 9 Then	'tab
				i3 = 8 - (.x And 7) '(.x mod 8)
				Dim j As Long
				Dim p = VarPtr(_PromptSys_Buffer[.y][.x]) As *Char
				' FillMemory(_PromptSys_Buffer[.y]+.x, i3, Asc(" "))
				For j = 0 To ELM(i3)
					p[j] = &h20 'Asc(" ")
				Next
				i2++
				.x += i3
				Continue
			End If

			If buf[i2] = 13 and buf[i2+1] = 10 Then	'\r\n
				i2 += 2
				.y++
				.x = 0
				Continue
			End If

			If buf[i2] = 0 Then Exit Do
			_PromptSys_Buffer[.y][.x] = buf[i2]
			_PromptSys_TextColor[.y][.x] = _PromptSys_NowTextColor
			_PromptSys_BackColor[.y][.x] = _PromptSys_NowBackColor

			i2++
			.x++
		Loop
		'Draw the text buffer added
		Dim hDC = GetDC(_PromptSys_hWnd)
		DrawPromptBuffer(hDC, StartLine, .y)
		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
	Dim hIMC As HIMC
	Dim hDC As HDC
	Dim ps As PAINTSTRUCT
	Dim TempStr As String
	Dim CompForm As COMPOSITIONFORM

	Select Case message
		Case WM_CREATE
			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
			GetTextExtentPoint32(_PromptSys_hMemDC, Ex" " As PCTSTR, 1, _PromptSys_FontSize)
			GetTextMetrics(_PromptSys_hMemDC, tm)
			SelectObject(_PromptSys_hMemDC, hOldFont)
			_PromptSys_FontSize.cy = tm.tmHeight

			ReleaseDC(hWnd,hDC)
		Case WM_PAINT
			hDC = BeginPaint(hWnd,ps)
			With _PromptSys_ScreenSize
				BitBlt(hDC, 0, 0, .cx, .cy, _PromptSys_hMemDC, 0, 0, SRCCOPY)
			End With
			DrawPromptBuffer(hDC, -1, 0)
			EndPaint(hWnd, ps)

			_PromptSys_bInitFinish = TRUE
		Case WM_SETFOCUS
			If _PromptSys_InputLen<>-1 Then
				hIMC = ImmGetContext(hWnd)
				If hIMC Then
					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,NULL,9,6)
				SetCaretPos(_PromptSys_CurPos.x*_PromptSys_FontSize.cx, _
					(_PromptSys_CurPos.y+1)*_PromptSys_FontSize.cy-7)
				ShowCaret(hWnd)
			End If
		Case WM_KILLFOCUS
			HideCaret(hWnd)
			DestroyCaret()
		Case WM_KEYDOWN
			If _PromptSys_InputLen=-1 Then
				_PromptSys_KeyChar=wParam As Byte
			End If
		Case WM_CHAR
			If _PromptSys_InputLen <> -1 Then
				If wParam = VK_BACK Then
					If _PromptSys_InputLen Then
						_PromptSys_InputLen--
						_PromptSys_InputStr[_PromptSys_InputLen] = 0

						_PromptSys_CurPos.x--
						_PromptSys_Buffer[_PromptSys_CurPos.y][_PromptSys_CurPos.x] = 0
					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 Return 0
					Dim pTemp = GlobalLock(hGlobal) As PCSTR
#ifdef UNICODE 'A版ウィンドウプロシージャ用
					Dim tempSizeW = MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 0, 0) + 1
					TempStr = ZeroString(tempSizeW)
					MultiByteToWideChar(CP_ACP, 0, pTemp, -1, 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
		Case WM_DESTROY
			DeleteDC(_PromptSys_hMemDC)
			DeleteObject(_PromptSys_hBitmap)

			PostQuitMessage(0)
		Case Else
			PromptProc=DefWindowProc(hWnd,message,wParam,lParam)
			Exit Function
	End Select
	PromptProc=0
End Function

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

	'Allocate
	For i=0 To 100
		_PromptSys_Buffer[i] = _System_calloc(SizeOf (Char) * 255)
		_PromptSys_TextColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
		_PromptSys_BackColor[i] = _System_calloc(SizeOf(COLORREF) * 255)
	Next

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

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

	'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
		lstrcpy(.lfFaceName, "ＭＳ 明朝")
	End With

	_PromptSys_hFont = CreateFontIndirect(ByVal VarPtr(_PromptSys_LogFont))

	'Critical Section
	InitializeCriticalSection(_PromptSys_SectionOfBufferAccess)

	'Regist Prompt Class
	Dim wcl As WNDCLASSEX
	FillMemory(VarPtr(wcl),Len(wcl),0)
	wcl.cbSize=Len(wcl)
	wcl.hInstance=GetModuleHandle(0)
	wcl.style=CS_HREDRAW or CS_VREDRAW or CS_DBLCLKS
	wcl.hIcon=LoadIcon(NULL,MAKEINTRESOURCE(IDI_APPLICATION))
	wcl.hIconSm=LoadIcon(NULL,MAKEINTRESOURCE(IDI_WINLOGO))
	wcl.hCursor=LoadCursor(NULL,MAKEINTRESOURCE(IDC_ARROW))
	wcl.lpszClassName="PROMPT"
	wcl.lpfnWndProc=AddressOf(PromptProc)
	wcl.hbrBackground=GetStockObject(BLACK_BRUSH)
	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,GetModuleHandle(0),0)
	ShowWindow(_PromptSys_hWnd,SW_SHOW)
	UpdateWindow(_PromptSys_hWnd)

	Dim msg As MSG, iResult As Long
	Do
		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_Buffer[i])
		_System_free(_PromptSys_TextColor[i])
		_System_free(_PromptSys_BackColor[i])
	Next

	LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)

	DeleteCriticalSection(_PromptSys_SectionOfBufferAccess)

	ExitProcess(0)
End Function


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

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

	'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
			FillMemory(_PromptSys_Buffer[i],255,0)
		Next
		_PromptSys_CurPos.x=0
		_PromptSys_CurPos.y=0
	End If

	If num=2 or num=3 Then
		'Clear the graphics screen
		hOldBrush=SelectObject(_PromptSys_hMemDC,GetStockObject(BLACK_BRUSH))
		PatBlt(_PromptSys_hMemDC,0,0,_PromptSys_ScreenSize.cx,_PromptSys_ScreenSize.cy,PATCOPY)
		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)
	Dim i As Long, i2 As Long

	If x<0 Then x=0
	If y<0 Then y=0
	If y>100 Then y=100

	_PromptSys_CurPos.x=x
	_PromptSys_CurPos.y=y

	i=0
	While _PromptSys_Buffer[y][i]
		i++
	Wend

	If i<x Then
		FillMemory(_PromptSys_Buffer[y]+i,x-i,Asc(" "))
		For i2=i To x-1
			_PromptSys_BackColor[y][i2]=-1
		Next
	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 hBrush As HBRUSH
	Dim radi2 As Long
	Dim sw As Long
	Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long

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

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

	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
		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

	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
		sx=_PromptSys_GlobalPos.x
		sy=_PromptSys_GlobalPos.y
	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)

	_PromptSys_GlobalPos.x=ex
	_PromptSys_GlobalPos.y=ey
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)

	_PromptSys_GlobalPos.x=x
	_PromptSys_GlobalPos.y=y
End Macro

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

	Dim hDC As HDC
	Dim hBrush As HBRUSH, hOldBrush As VoidPtr
	
	hBrush=CreateSolidBrush(GetBasicColor(BrushColor))

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

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

	ReleaseDC(_PromptSys_hWnd,hDC)
	SelectObject(_PromptSys_hMemDC,hOldBrush)
	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