Changeset 258

Timestamp:

May 21, 2007, 1:03:21 AM (17 years ago)

Author:

イグトランス (egtra)

Message:

Prompt.sbp内を名前空間に入れた。EnvironmentのMachineName, UserName, GetFolderPathを実装。

Location:

Include

Files:

• Classes/System/Environment.ab (modified) (5 diffs)
• Classes/System/OperatingSystem.ab (modified) (6 diffs)
• Classes/System/Threading/WaitHandle.ab (modified) (3 diffs)
• api_shell.sbp (modified) (2 diffs)
• api_system.sbp (modified) (2 diffs)
• basic.sbp (modified) (1 diff)
• basic/command.sbp (modified) (1 diff)
• basic/function.sbp (modified) (1 diff)
• basic/prompt.sbp (modified) (33 diffs)
• system/string.sbp (modified) (2 diffs)

Include/Classes/System/Environment.ab

@@ -3 +3 @@
 #require <api_psapi.sbp>
 #require <Classes/System/OperatingSystem.ab>
+
+Namespace System
+
+Namespace Detail
+    TypeDef PFNGetProcessMemoryInfo = *Function(Process As HANDLE, ByRef mc As PROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL
+End Namespace
 
 Class Environment
@@ -45 +51 @@
     End Function
 
-    ' MachineName
+    Static Function MachineName() As String
+        If Object.ReferenceEquals(machineName, Nothing) Then
+            Dim buf[MAX_COMPUTERNAME_LENGTH] As TCHAR
+            Dim len = (MAX_COMPUTERNAME_LENGTH + 1) As DWord
+            GetComputerName(buf, len)
+            machineName = New String(buf, len As Long)
+        End If
+        Return machineName
+    End Function            
 
     Static Function NewLine() As String
@@ -90 +104 @@
     ' UserInteractive
 
-    ' UserName
+    Static Function UserName() As String
+        If Object.ReferenceEquals(userName, Nothing) Then
+            Dim buf[UNLEN] As TCHAR
+            Dim len = (UNLEN + 1) As DWord
+            GetUserName(buf, len)
+            userName = New String(buf, len As Long)
+        End If
+        Return userName
+    End Function            
 
     ' Version
 
+Public
+    'NTでしか使用できない仕様
     Static Function WorkingSet() As Int64
-        TypeDef PFNGetProcessMemoryInfo = *Function(Process As HANDLE, ByRef mc As PROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL
-        Dim pGetProcessMemoryInfo As PFNGetProcessMemoryInfo
         Dim hmodPSAPI = LoadLibrary("PSAPI.DLL")
         If hmodPSAPI = 0 Then Return 0
-        pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo")) As PFNGetProcessMemoryInfo
+        Dim pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo")) As Detail.PFNGetProcessMemoryInfo
         If pGetProcessMemoryInfo <> 0 Then
             Dim mc As PROCESS_MEMORY_COUNTERS
@@ -136 +158 @@
     ' GetEnvironmentVariables
 
+    Static Function GetFolderPath(f As Environment_SpecialFolder) As String
+'       If ... Then
+'           Throw New ArgumentException
+'       End If
+        Dim x As Long
+        x = f
+        Return ActiveBasic.Windows.GetFolderPath(x)
+    End Function
+
     ' GetLogicalDrives
 
@@ -143 +174 @@
     Static cmdLine = Nothing As String
     Static exitCode = 0 As Long
+    Static machineName = Nothing As String
     Static osVer = Nothing As OperatingSystem
     Static processorCount = 0 As Long
     Static sysDir = Nothing As String
+    Static userName = Nothing As String
 End Class
+
+Enum Environment_SpecialFolder
+    Desktop = CSIDL_DESKTOP
+    Programs = CSIDL_PROGRAMS
+    Personal = CSIDL_PERSONAL
+    MyDocuments = CSIDL_PERSONAL
+    Favorites = CSIDL_FAVORITES
+    Startup = CSIDL_STARTUP
+    Recent = CSIDL_RECENT
+    SendTo = CSIDL_SENDTO
+    StartMenu = CSIDL_STARTMENU
+    MyMusic = CSIDL_MYMUSIC
+    DesktopDirectory = CSIDL_DESKTOPDIRECTORY
+    MyComputer = CSIDL_DRIVES
+    Templates = CSIDL_TEMPLATES
+    ApplicationData = CSIDL_APPDATA '4.71
+    LocalApplicationData = CSIDL_LOCAL_APPDATA
+    InternetCache = CSIDL_INTERNET_CACHE
+    Cookies = CSIDL_COOKIES
+    History = CSIDL_HISTORY
+    CommonApplicationData = CSIDL_COMMON_APPDATA '5.0
+    System = CSIDL_SYSTEM
+    CommonProgramFiles = CSIDL_PROGRAM_FILES
+    ProgramFiles = CSIDL_PROGRAM_FILES
+    MyPictures = CSIDL_MYPICTURES
+End Enum
+
+
+End Namespace 'System

Include/Classes/System/OperatingSystem.ab

@@ -6 +6 @@
 #require <Classes/System/Version.ab>
 
+Namespace System
+
 Class OperatingSystem
     ' Inherits ICloneable', ISerializable
 Public
     ' Constractor
-    Sub OperatingSystem(platform As PlatformID, version As System.Version)
+    Sub OperatingSystem(platform As PlatformID, version As Version)
         pf = platform
         ver = version
@@ -18 +20 @@
     Sub OperatingSystem(vi As OSVERSIONINFOA)
         pf = vi.dwPlatformId As PlatformID
-        ver = New System.Version(vi.dwMajorVersion, vi.dwMinorVersion, vi.dwBuildNumber)
+        ver = New Version(vi.dwMajorVersion, vi.dwMinorVersion, vi.dwBuildNumber)
         sp = New String(vi.szCSDVersion As PCSTR)
     End Sub
@@ -24 +26 @@
     Sub OperatingSystem(vi As OSVERSIONINFOW)
         pf = vi.dwPlatformId As PlatformID
-        ver = New System.Version(vi.dwMajorVersion, vi.dwMinorVersion, vi.dwBuildNumber)
+        ver = New Version(vi.dwMajorVersion, vi.dwMinorVersion, vi.dwBuildNumber)
         sp = New String(vi.szCSDVersion As PCSTR)
     End Sub
@@ -33 +35 @@
     End Function
 
-    Const Function Version() As System.Version
+    Const Function Version() As Version
         Return ver
     End Function
@@ -71 +73 @@
 Private
     pf As PlatformID
-    ver As System.Version
+    ver As Version
     sp As String
 End Class
@@ -83 +85 @@
 End Enum
 
+End Namespace
+
 #endif '__SYSYTEM_OPERATINGSYSTEM_AB__

Include/Classes/System/Threading/WaitHandle.ab

@@ -3 +3 @@
 #ifndef __SYSTEM_THREADING_WAITHANDLE_AB__
 #define __SYSTEM_THREADING_WAITHANDLE_AB__
+
+'Namespace System
+'Namespace Threading
+
+Namespace Detail
+    TypeDef PFNSignalObjectAndWait = *Function(hObjectToSignal As HANDLE, hObjectToWaitOn As HANDLE, dwMilliseconds As DWord, bAlertable As DWord) As DWord
+End Namespace
 
 Class WaitHandle
@@ -62 +69 @@
     End Function
 
+Public
     Static Function SignalAndWait(ByRef toSignal As WaitHandle, ByRef toWaitOn As WaitHandle, millisecondsTimeout As Long, exitContext As BOOL) As BOOL
-        TypeDef PFNSignalObjectAndWait = *Function(hObjectToSignal As HANDLE, hObjectToWaitOn As HANDLE, dwMilliseconds As DWord, bAlertable As DWord) As DWord
-        Dim pSignalObjectAndWait = GetProcAddress(GetModuleHandle("Kernel32.dll"), "SignalObjectAndWait") As PFNSignalObjectAndWait
+        Dim pSignalObjectAndWait = GetProcAddress(GetModuleHandle("Kernel32.dll"), "SignalObjectAndWait") As Detail.PFNSignalObjectAndWait
         If pSignalObjectAndWait = 0 Then
             ' PlatformNotSupportedException
@@ -105 +112 @@
 End Class
 
+'End Namespace 'Threading
+'End Namespace 'System
+
 #endif '__SYSTEM_THREADING_WAITHANDLE_AB__

Include/api_shell.sbp

@@ -374 +374 @@
 
 ' ShlObj.h
+
+'要IE4
 Declare Function SHGetSpecialFolderPath Lib "shell32" Alias _FuncName_SHGetSpecialFolderPath (hwndOwner As HWND, lpszPath As LPTSTR, nFolder As Long, fCreate As BOOL) As BOOL
 
@@ -379 +381 @@
 Declare Function SHGetInstanceExplorer Lib "shell32" (ByRef ppunk As *IUnknown) As HRESULT
 
-Const CSIDL_PERSONAL = 5
-Const CSIDL_FAVORITIES = 6
+'shlobj.h
+Declare Function SHGetSpecialFolderLocation Lib "shell32" (hwndOwner As HWND, nFolder As Long, ByRef pidl As LPITEMIDLIST) As HRESULT
+
+'shlobj.h
+'要Win2k/Me
+'Declare Function SHGetFolderLocation Lib "shell32" (hwndOwner As HWND, nFolder As Long, hToken As HANDLE, dwReserved As DWord, ByRef pidl As LPITEMIDLIST) As HRESULT
+
+Const CSIDL_DESKTOP = &h0000
+Const CSIDL_INTERNET = &h0001
+Const CSIDL_PROGRAMS = &h0002
+Const CSIDL_CONTROLS = &h0003
+Const CSIDL_PRINTERS = &h0004
+Const CSIDL_PERSONAL = &h0005
+Const CSIDL_FAVORITES = &h0006
+Const CSIDL_STARTUP = &h0007
+Const CSIDL_RECENT = &h0008
+Const CSIDL_SENDTO = &h0009
+Const CSIDL_BITBUCKET = &h000a
+Const CSIDL_STARTMENU = &h000b
+Const CSIDL_MYMUSIC = &h000d
+Const CSIDL_DESKTOPDIRECTORY = &h0010
+Const CSIDL_DRIVES = &h0011
+Const CSIDL_NETWORK = &h0012
+Const CSIDL_NETHOOD = &h0013
+Const CSIDL_FONTS = &h0014
+Const CSIDL_TEMPLATES = &h0015
+Const CSIDL_COMMON_STARTMENU = &h0016
+Const CSIDL_COMMON_PROGRAMS = &h0017
+Const CSIDL_COMMON_STARTUP = &h0018
+Const CSIDL_COMMON_DESKTOPDIRECTORY = &h0019
+Const CSIDL_APPDATA = &h001a
+Const CSIDL_PRINTHOOD = &h001b
+Const CSIDL_LOCAL_APPDATA = &h001c
+Const CSIDL_ALTSTARTUP = &h001d
+Const CSIDL_COMMON_ALTSTARTUP = &h001e
+Const CSIDL_COMMON_FAVORITES = &h001f
+Const CSIDL_INTERNET_CACHE = &h0020
+Const CSIDL_COOKIES = &h0021
+Const CSIDL_HISTORY = &h0022
+Const CSIDL_COMMON_APPDATA = &h0023
+Const CSIDL_WINDOWS = &h0024
+Const CSIDL_SYSTEM = &h0025
+Const CSIDL_PROGRAM_FILES = &h0026
+Const CSIDL_MYPICTURES = &h0027
+Const CSIDL_PROFILE = &h0028
+Const CSIDL_PROGRAM_FILES_COMMON = &h002b
+Const CSIDL_COMMON_TEMPLATES = &h002d
+Const CSIDL_COMMON_DOCUMENTS = &h002e
+Const CSIDL_COMMON_ADMINTOOLS = &h002f
+Const CSIDL_ADMINTOOLS = &h0030
 
 Const SHGFI_ICON              = &H000000100

Include/api_system.sbp

@@ -213 +213 @@
 Const MUTEX_ALL_ACCESS = MUTANT_ALL_ACCESS
 
+'Lmcons.ab
+Const UNLEN = 256
+
 '----------------------
 ' Kernel Operation API
@@ -465 +468 @@
 
 Const MAX_COMPUTERNAME_LENGTH = 15
-Declare Function GetComputerName Lib "kernel32" Alias _FuncName_GetComputerName (pBuffer As PTSTR, ByRef nSize As Long) As Long
+Declare Function GetComputerName Lib "kernel32" Alias _FuncName_GetComputerName (pBuffer As PTSTR, ByRef nSize As DWord) As BOOL
 
 Declare Function GetCurrentDirectory Lib "kernel32" Alias _FuncName_GetCurrentDirectory (nBufferLength As DWord, pBuffer As PTSTR) As DWord

Include/basic.sbp

@@ -12 +12 @@
 End Sub
 
+Const QWORD_MAX = &HFFFFFFFFFFFFFFFF As QWord
+Const INT64_MAX = &H7FFFFFFFFFFFFFFF As Int64
+Const INT64_MIN = &H8000000000000000 As Int64
 
-Const LONG_MAX = &H7FFFFFFF
-Const LONG_MIN = &H80000000
+Const DWORD_MAX = &HFFFFFFFF As DWord
+Const LONG_MAX = &H7FFFFFFF As Long
+Const LONG_MIN = &H80000000 As Long
+
+Const WORD_MAX = &HFFFF As Word
+Const INTEGER_MAX = &H7FFF As Integer
+Const INTEGER_MIN = &H8000 As Integer
+
+Const BYTE_MAX = &HFF As Byte
+Const SBYTE_MAX = &H7F As SByte
+Const SBYTE_MIN = &H80 As SByte
+
+Const DBL_MAX = 1.7976931348623158e+308
+Const DBL_MIN = 2.2250738585072014e-308
 
 Const FLT_MAX = 3.402823466e+38

Include/basic/command.sbp

@@ -34 +34 @@
 
 Sub _System_End()
-    Dim exitCode = Environment.ExitCode
+    Dim exitCode = System.Environment.ExitCode
     _System_EndProgram()
     ExitProcess(exitCode)

Include/basic/function.sbp

@@ -1231 +1231 @@
 End Function
 
+Namespace ActiveBasic
+    Namespace Windows
+        Function GetPathFromIDList(pidl As LPITEMIDLIST) As String
+            Dim buf[ELM(MAX_PATH)] As TCHAR
+            If SHGetPathFromIDList(pidl, buf) Then
+                Return New String(buf)
+            Else
+                Return ""
+            End If
+        End Function
+
+        Function GetFolderPath(hwnd As HWND, folder As Long) As String
+            Dim pidl As LPITEMIDLIST
+            Dim hr = SHGetSpecialFolderLocation(hwnd, folder, pidl)
+            If SUCCEEDED(hr) Then
+                GetFolderPath = GetPathFromIDList(pidl)
+                CoTaskMemFree(pidl)
+            Else
+                GetFolderPath = ""
+            End If
+        End Function
+
+        Function GetFolderPath(folder As Long) As String
+            Return GetFolderPath(0, folder)
+        End Function
+    End Namespace
+End Namespace
+
 #endif '_INC_FUNCTION

Include/basic/prompt.sbp

@@ -5 +5 @@
 #define _INC_PROMPT
 
-
 #require <api_imm.sbp>
 #require <Classes/System/Math.ab>
-
+#require <Classes/System/Environment.ab>
+
+Namespace ActiveBasic
+Namespace Prompt
+Namespace Detail
+    
 Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCSTR, cb As Long, ByRef Size As SIZE) As Long
     _PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32A(hdc, psz, cb, Size)
@@ -50 +54 @@
 End Type
 
-Dim _PromptSys_LogFont As LOGFONT
 Dim _PromptSys_hFont As HFONT
 Dim _PromptSys_FontSize As SIZE
 Dim _PromptSys_InputStr[255] As StrChar
-Dim _PromptSys_InputLen As Long
+Dim _PromptSys_InputLen = -1 As Long
 Dim _PromptSys_KeyChar As Byte
 Dim _PromptSys_CurPos As POINTAPI
@@ -64 +67 @@
 Dim _System_OSVersionInfo As OSVERSIONINFO
 
-_PromptSys_InputLen = -1
 
 'graphic
@@ -72 +74 @@
 Dim _PromptSys_GlobalPos As POINTAPI
 
+Sub _PromptSys_Initialize()
 _PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0)
-Dim _PromptSys_hThread As HANDLE
-_PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID)
+Dim _PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain), 0, 0, _PromptSys_dwThreadID)
 If _PromptSys_hThread = 0 Then
     Debug
@@ -80 +82 @@
 End If
 WaitForSingleObject(_PromptSys_hInitFinish, INFINITE)
+End Sub
 
 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
@@ -267 +270 @@
     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)
+    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)
@@ -287 +290 @@
             End With
             ImmSetCompositionWindow(himc, CompForm)
-            ImmSetCompositionFont(himc, _PromptSys_LogFont)
+
+            Dim lf As LOGFONT
+            GetObject(_PromptSys_hFont, Len(lf), lf)
+            ImmSetCompositionFont(himc, lf)
         End If
         ImmReleaseContext(hwnd, himc)
@@ -365 +371 @@
 
         SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
-        PRINT_ToPrompt(TempStr)
+        ActiveBasic.Prompt.Detail.PRINT_ToPrompt(TempStr)
         SendMessage(hwnd, WM_SETFOCUS, 0, 0)
     End If
@@ -372 +378 @@
 Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long
     Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
-    rpsz = _System_malloc(size) As PTSTR
+    rpsz = _System_malloc(size) As PWSTR
     If rpsz = 0 Then
         'Debug
@@ -382 +388 @@
 Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long
     Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
-    rpsz = _System_malloc(size) As PTSTR
+    rpsz = _System_malloc(size) As PSTR
     If rpsz = 0 Then
         'Debug
@@ -403 +409 @@
         tempStr.Assign(str, size)
 #else
-        With _System_OSVersionInfo
+        Dim osver = System.Environment.OSVersion
+        With osver
             ' GetCompositionStringW is not implimented in Windows 95 
-            If .dwMajorVersion = 4 And .dwMinorVersion = 0 And .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
+            If .Version.Major = 4 And .Version.Minor = 0 And .Platform = System.PlatformID.Win32Windows Then
                 Dim strA As PCSTR
                 Dim sizeA = _PromptWnd_GetCompositionStringA(himc, strA)
@@ -421 +428 @@
         _PromptSys_InputLen += tempStr.Length
 
-        SendMessage(hwnd, WM_KILLFOCUS, 0, 0) : Debug
-        PRINT_ToPrompt(tempStr)
+        SendMessage(hwnd, WM_KILLFOCUS, 0, 0)
+        ActiveBasic.Prompt.Detail.PRINT_ToPrompt(tempStr)
         SendMessage(hwnd, WM_SETFOCUS, 0, 0)
 
@@ -454 +461 @@
     End With
 
-    'LogFont initialize
-    With _PromptSys_LogFont
+    '_PromptSys_hFont initialize
+    Dim lf As LOGFONT
+    With lf
         .lfHeight = -16
         .lfWidth = 0
@@ -469 +477 @@
         .lfQuality = DEFAULT_QUALITY
         .lfPitchAndFamily = FIXED_PITCH
-        lstrcpy(.lfFaceName, "ＭＳ 明朝")
-    End With
-
-    _PromptSys_hFont = CreateFontIndirect(_PromptSys_LogFont)
+        lstrcpy(.lfFaceName, ToTCStr("ＭＳ 明朝"))
+    End With
+
+    _PromptSys_hFont = CreateFontIndirect(lf)
 
     'Critical Section
@@ -487 +495 @@
         .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"
+        .lpszClassName = ToTCStr("PROMPT")
         .lpfnWndProc = AddressOf(PromptProc)
         .hbrBackground = GetStockObject(BLACK_BRUSH)
@@ -494 +502 @@
 
     'Create Prompt Window
-    _PromptSys_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, atom As ULONG_PTR As LPCTSTR, "BASIC PROMPT", _
+    _PromptSys_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, atom As ULONG_PTR As LPCTSTR, ToTCStr("BASIC PROMPT"), _
         WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
         0, 0, wcl.hInstance, 0)
@@ -503 +511 @@
     Do
         Dim iResult = GetMessage(msg, 0, 0, 0)
-        If iResult = 0 Or iResult = -1 Then Exit Do
+        If iResult = 0 Then
+            System.Environment.ExitCode = msg.wParam As Long
+            Exit Do
+        ElseIf iResult = -1 Then
+            Exit Do
+        End If
         TranslateMessage(msg)
         DispatchMessage(msg)
@@ -509 +522 @@
 
     '強制的に終了する
-    End 'ExitProcess(0)
+    End
 
     EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
@@ -522 +535 @@
     DeleteCriticalSection(_PromptSys_SectionOfBufferAccess)
 
-    End 'ExitProcess(0)
-End Function
-
-
-'----------------------
-' Prompt text Commands
-'----------------------
-
-Macro CLS()(num As Long)
+    End
+End Function
+
+'Prompt text command functoins
+
+Sub Cls(n 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
+    If n = 0 Then n = 1
+
+    If n = 1 Or n = 3 Then
         'Clear the text screen
         For i = 0 To 100
@@ -550 +560 @@
     End If
 
-    If num = 2 Or num = 3 Then
+    If n = 2 Or n = 3 Then
         'Clear the graphics screen
         Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH))
@@ -561 +571 @@
     '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
+End Sub
+
+Sub 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)
+        _PromptSys_NowBackColor = GetBasicColor(backColorCode)
+    End If
+End Sub
+
+Sub INPUT_FromPrompt(showStr As String)
     Dim i As Long, i2 As Long, i3 As Long
     Dim buf As String
@@ -582 +588 @@
 *InputReStart
 
-    PRINT_ToPrompt(ShowStr)
+    ActiveBasic.Prompt.Detail.PRINT_ToPrompt(showStr)
 
     'Input by keyboard
@@ -616 +622 @@
         i++
         If _System_InputDataPtr[i] = 0 and _PromptSys_InputStr[i2] = &h2c Then 'Asc(",")
-            PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
+            ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n")
             Goto *InputReStart
         ElseIf _PromptSys_InputStr[i2] = 0 Then
             If _System_InputDataPtr[i]<>0 Then
-                PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
+                ActiveBasic.Prompt.Detail.PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n")
                 Goto *InputReStart
             Else
@@ -631 +637 @@
 End Sub
 
-Sub PRINTUSING_ToPrompt(UsingStr As String)
-    PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
-End Sub
-
-Macro LOCATE(x As Long, y As Long)
+Sub Locate(x As Long, y As Long)
     If x < 0 Then x = 0
     If y < 0 Then y = 0
@@ -653 +655 @@
         _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]
-
+End Sub
+
+'Prompt graphic command functions
+
+Sub 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)
     Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long
 
@@ -763 +759 @@
     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]
+End Sub
+
+Sub 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)
     Dim temp As Long
 
@@ -796 +790 @@
     End If
 
-    Dim hDC = GetDC(_PromptSys_hWnd)
+    Dim hdc = GetDC(_PromptSys_hWnd)
     Dim hPen = CreatePen(PS_SOLID, 1, GetBasicColor(ColorCode))
     Dim hBrush As HBRUSH
@@ -805 +799 @@
     End If
 
-    SelectObject(hDC, hPen)
-    SelectObject(hDC, hBrush)
+    SelectObject(hdc, hPen)
+    SelectObject(hdc, hBrush)
     Dim hOldPen = SelectObject(_PromptSys_hMemDC, hPen)
     Dim hOldBrush = SelectObject(_PromptSys_hMemDC, hBrush)
@@ -816 +810 @@
             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))
+            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(hdc,sx,sy,ex+1,ey+1)
             Rectangle(_PromptSys_hMemDC,sx,sy,ex+1,ey+1)
     End Select
 
-    ReleaseDC(_PromptSys_hWnd,hDC)
+    ReleaseDC(_PromptSys_hWnd,hdc)
     SelectObject(_PromptSys_hMemDC,hOldPen)
     SelectObject(_PromptSys_hMemDC,hOldBrush)
@@ -834 +828 @@
         .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))
+End Sub
+
+Sub PSet(x As Long, y As Long, ColorCode As Long)
+    Dim hdc = GetDC(_PromptSys_hWnd)
+    SetPixel(hdc, x, y, GetBasicColor(ColorCode))
     SetPixel(_PromptSys_hMemDC, x, y, GetBasicColor(ColorCode))
-    ReleaseDC(_PromptSys_hWnd, hDC)
+    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)
+End Sub
+
+Sub Paint(x As Long, y As Long, BrushColor As Long, LineColor As Long)
+    Dim hbr = CreateSolidBrush(GetBasicColor(BrushColor))
+
+    Dim hdc = GetDC(_PromptSys_hWnd)
+    Dim hbrOld = SelectObject(_PromptSys_hMemDC, hbr)
+    Dim hbrOldWndDC = SelectObject(hdc, hbr)
+
+    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
-'-----------
+    ReleaseDC(_PromptSys_hWnd, hdc)
+    SelectObject(_PromptSys_hMemDC, hbrOld)
+    SelectObject(hdc, hbrOldWndDC)
+    DeleteObject(hbr)
+End Sub
 
 Function Inkey$() As String
@@ -884 +867 @@
 
 Function Input$(length As Long) As String
-    Dim i As Long
+    Dim i = 0 As Long
 
     If length<=0 Then
@@ -891 +874 @@
     End If
 
-    i=0
     While 1
         If _PromptSys_KeyChar Then
@@ -905 +887 @@
 End Function
 
+End Namespace 'Detail
+
+Function OwnerWnd() As HWND
+    Return Detail._PromptSys_hWnd
+End Function
+
+End Namespace 'Prompt
+End Namespace 'ActiveBasic
+
+'----------------------
+' Prompt text Commands
+'----------------------
+
+Sub PRINT_ToPrompt(s As String)
+    ActiveBasic.Prompt.Detail.PRINT_ToPrompt(s)
+End Sub
+
+Macro CLS()(num As Long)
+    ActiveBasic.Prompt.Detail.Cls(num)
+End Macro
+
+Macro COLOR(TextColorCode As Long)(BackColorCode As Long)
+    ActiveBasic.Prompt.Detail.Color(TextColorCode, BackColorCode)
+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)
+    ActiveBasic.Prompt.Detail.INPUT_FromPrompt(ShowStr)
+End Sub
+
+Sub PRINTUSING_ToPrompt(UsingStr As String)
+    ActiveBasic.Prompt.Detail.PRINT_ToPrompt(_System_GetUsingFormat(UsingStr))
+End Sub
+
+Macro LOCATE(x As Long, y As Long)
+    ActiveBasic.Prompt.Detail.Locate(x, y)
+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]
+    ActiveBasic.Prompt.Detail.Circle(x, y, radius, ColorCode, StartPos, EndPos, Aspect, bFill, BrushColor)
+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]
+    ActiveBasic.Prompt.Detail.Line(sx, sy, bStep, ex, ey, ColorCode, fType, BrushColor)
+End Macro
+
+Macro PSET(x As Long, y As Long)(ColorCode As Long)
+    '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
+    'PSet (x,y),ColorCode
+    ActiveBasic.Prompt.Detail.PSet(x, y, ColorCode)
+End Macro
+
+Macro PAINT(x As Long, y As Long, BrushColor As Long)(ByVal LineColor As Long)
+    '呼び出し方法は以下のようになります（コンパイラがパラメータの並びを最適化します）
+    'Paint (x,y),BrushColor,LineColor
+    ActiveBasic.Prompt.Detail.Paint(x, y, BrushColor, LineColor)
+End Macro
+
+
+'-----------
+' Functions
+'-----------
+
+Function Inkey$() As String
+    Return ActiveBasic.Prompt.Detail.Inkey$()
+End Function
+
+Function Input$(length As Long) As String
+    Return ActiveBasic.Prompt.Detail.Input$(length)
+End Function
+
+ActiveBasic.Prompt.Detail._PromptSys_Initialize()
 
 #endif '_INC_PROMPT

Include/system/string.sbp

@@ -157 +157 @@
 
 Function GetTCStr(s As String, ByRef tcs As PCTSTR) As SIZE_T
-    Return GetStr(s.Chars, s.Length As SIZE_T, wcs)
+    Return GetStr(s.Chars, s.Length As SIZE_T, tcs)
 End Function
 
@@ -177 +177 @@
 
 Function GetSCStr(s As String, ByRef ss As *StrChar) As SIZE_T
-    Return GetStr(s.Chars, s.Length As SIZE_T, wcs)
+    Return GetStr(s.Chars, s.Length As SIZE_T, ss)
 End Function