source: Include/basic/prompt.sbp@ 125

'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_TextWidth[100] As Long
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, 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_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]
            _PromptSys_TextWidth[i] = _PromptSys_TextWidth[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_TextWidth[100] = 0

        _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
            Dim sz As SIZE
            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)

            Dim width = 0 As Long
            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 temporary[2] As Char
                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, width, i * .cy, temporary, tempLen)
                End With
                GetTextExtentPoint32(hDC, temporary, i3, sz)
                width += sz.cx
            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)
                _System_FillChar(VarPtr(_PromptSys_Buffer[.y][.x]), i3, &h20) 'Asc(" ")
                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, " " 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)
*/
            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
        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 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
        Case WM_IME_COMPOSITION
            Return _PromptSys_OnImeCompostion(hWnd, wParam, lParam)
        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 _PromptSys_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)

        Return 0
    Else
        Return 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
        _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
    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(ByVal VarPtr(_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 = LoadIcon(NULL, MAKEINTRESOURCE(IDI_APPLICATION))
        .hIconSm = LoadIcon(NULL, MAKEINTRESOURCE(IDI_WINLOGO))
        .hCursor = LoadCursor(NULL, MAKEINTRESOURCE(IDC_ARROW))
        .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_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
            _System_FillChar(_PromptSys_Buffer[i],255,0)
        Next
        With _PromptSys_CurPos
            .x = 0
            .y = 0
        End With
    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
    With _PromptSys_CurPos
        .x = x
        .y = y
    End With
    i=0
    While _PromptSys_Buffer[y][i]
        i++
    Wend

    If i < x Then
        _System_FillChar(VarPtr(_PromptSys_Buffer[y][i]), x - i, &h20) '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