Changeset 142 for Include/basic
- Timestamp:
- Mar 9, 2007, 10:15:34 PM (18 years ago)
- Location:
- Include/basic
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Include/basic/command.sbp
r123 r142 5 5 #define _INC_COMMAND 6 6 7 #require <windows.sbp> 8 #require <Classes/System/Environment.ab> 7 9 8 10 Const _System_Type_SByte = 1 … … 33 35 Macro END() 34 36 _System_Call_Destructor_of_GlobalObject() 35 ExitProcess( 0)36 End Macro 37 38 Macro EXEC( lpFilePath As *Byte)(lpCmdLine As *Byte)39 ShellExecute(0, "open",lpFilePath,lpCmdLine,0,SW_SHOWNORMAL)37 ExitProcess(Environment.ExitCode) 38 End Macro 39 40 Macro EXEC(filePath As String)(cmdLine As String) 41 ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL) 40 42 End Macro 41 43 … … 52 54 Macro WRITE() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照) 53 55 End Macro 54 55 56 56 57 '---------------- … … 58 59 '---------------- 59 60 60 Macro MSGBOX(hWnd As HWND, lpStr As String)(lpTitle As String, BoxType As DWord, ByRef retAns As DWord) 61 Function _System_MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord 62 Return MessageBoxA(hw, s, t, b) 63 End Function 64 65 Function _System_MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord 66 Return MessageBoxW(hw, s, t, b) 67 End Function 68 69 Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord) 61 70 If VarPtr(retAns) Then 62 retAns =MessageBox(hWnd,lpStr,lpTitle,BoxType)71 retAns = _System_MessageBox(hwnd, str, title, boxType) 63 72 Else 64 MessageBox(hWnd,lpStr,lpTitle,BoxType)73 _System_MessageBox(hwnd, str, title, boxType) 65 74 End If 66 75 End Macro 67 76 68 Macro WINDOW(ByRef hWnd As HWND, hOwner As HWND, x As Long, y As Long, nWidth As Long, nHeight As Long, lpTitle As String, dwStyle As DWord)(lpClass As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord) 69 If VarPtr(hWnd) Then 70 hWnd=CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL) 71 Else 72 CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL) 77 Macro WINDOW(ByRef hwndRet As HWND, hOwner As HWND, x As Long, y As Long, width As Long, height As Long, title As String, dwStyle As DWord)(className As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord) 78 Dim hwnd = CreateWindowEx(dwExStyle, ToTCStr(className), ToTCStr(title), dwStyle, x, y, width, height, hOwner, id, GetModuleHandle(0), 0) 79 If VarPtr(hwndRet) Then 80 hwndRet = hwnd 73 81 End If 74 82 End Macro … … 78 86 End Macro 79 87 80 Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)( lpStringAs String, id As Long, hSubMenu As HMENU, state As Long)88 Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long) 81 89 Dim mii As MENUITEMINFO 82 90 ZeroMemory(VarPtr(mii), Len(mii)) … … 90 98 .fType = MFT_STRING 91 99 .fMask = .fMask or MIIM_STATE or MIIM_ID 92 .dwTypeData = StrPtr(lpString)100 .dwTypeData = ToTCStr(str) 93 101 .wID = id 94 102 If hSubMenu Then … … 96 104 .hSubMenu = hSubMenu 97 105 End If 98 .fState =state106 .fState = state 99 107 End If 100 108 End With … … 108 116 109 117 Dim _System_hFile(255) As HANDLE 110 Macro OPEN( lpFileName As String, AccessFor As Long, FileNumber As Long)111 Dim dwAccess As Long112 Dim bAppend = 0 As Long113 Dim dwCreationDisposition As Long118 Macro OPEN(fileName As String, AccessFor As Long, FileNumber As Long) 119 Dim access As Long 120 Dim bAppend = False As Boolean 121 Dim creationDisposition As Long 114 122 115 123 FileNumber-- … … 117 125 Select Case AccessFor 118 126 Case 0 119 dwAccess=GENERIC_READ or GENERIC_WRITE120 dwCreationDisposition=OPEN_ALWAYS127 access = GENERIC_READ or GENERIC_WRITE 128 creationDisposition = OPEN_ALWAYS 121 129 Case 1 122 dwAccess=GENERIC_READ123 dwCreationDisposition=OPEN_EXISTING130 access = GENERIC_READ 131 creationDisposition = OPEN_EXISTING 124 132 Case 2 125 dwAccess=GENERIC_WRITE126 dwCreationDisposition=CREATE_ALWAYS133 access = GENERIC_WRITE 134 creationDisposition = CREATE_ALWAYS 127 135 Case 3 128 dwAccess=GENERIC_WRITE129 dwCreationDisposition=OPEN_ALWAYS130 bAppend =1136 access = GENERIC_WRITE 137 creationDisposition = OPEN_ALWAYS 138 bAppend = True 131 139 End Select 132 140 133 _System_hFile(FileNumber) =CreateFile(lpFileName,dwAccess,0,ByVal NULL,dwCreationDisposition,FILE_ATTRIBUTE_NORMAL,NULL)134 135 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0,NULL,FILE_END)141 _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0) 142 143 If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END) 136 144 End Macro 137 145 … … 151 159 Dim i As Long ,i2 As Long, i3 As Long 152 160 Dim buffer As String 153 Dim temp[1] As Char161 Dim temp[1] As StrChar 154 162 Dim dwAccessBytes As DWord 155 163 Dim IsStr As Long … … 163 171 '次のデータをサーチ 164 172 Do 165 i2=ReadFile(_System_hFile[FileNumber],temp, 1,VarPtr(dwAccessBytes),ByVal 0)173 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) 166 174 If i2=0 or dwAccessBytes=0 Then 167 175 'error … … 177 185 i3++ 178 186 179 i2=ReadFile(_System_hFile[FileNumber],temp, 1,VarPtr(dwAccessBytes),ByVal 0)187 i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) 180 188 If i2=0 or (i3=0 and dwAccessBytes=0) Then 181 189 'error … … 187 195 If dwAccessBytes=0 or temp[0]=0 or temp[0]=13 or temp[0]=10 or (IsStr=0 and temp[0]=Asc(",")) or (IsStr=0 and (temp[0]=32 or temp[0]=9) and _System_InputDataType[i]<>_System_Type_String) Then 188 196 If temp[0]=13 Then 189 ReadFile(_System_hFile[FileNumber],temp, 1,VarPtr(dwAccessBytes),ByVal 0)197 ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) 190 198 If Not(dwAccessBytes<>0 And temp[0]=10) Then 191 199 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT) … … 240 248 pTempStr = arg As *String 241 249 pTempStr->ReSize(bufLen) 242 memcpy(pTempStr->Chars, buf.Chars, SizeOf ( Char) * pTempStr->Length)250 memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length) 243 251 pTempStr->Chars[pTempStr->Length] = 0 244 252 End Select … … 249 257 FileNumber-- 250 258 251 WriteFile(_System_hFile(FileNumber), buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL)259 WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0) 252 260 End Sub 253 261 … … 257 265 Function _System_GetUsingFormat(UsingStr As String) As String 258 266 Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long 259 Dim temporary[255] As Char267 Dim temporary[255] As StrChar 260 268 Dim buffer As String 261 269 262 buffer =ZeroString(1024)263 264 ParmNum =0265 i2 =0270 buffer = ZeroString(1024) 271 272 ParmNum = 0 273 i2 = 0 266 274 While 1 267 275 While 1 … … 277 285 If UsingStr[i2]=Asc("#") Then 278 286 Dim dec As Long, sign As Long 279 Dim temp2 As * Char287 Dim temp2 As *StrChar 280 288 281 289 Dim length_num As Long, length_buf As Long … … 332 340 333 341 If dec > 0 Then 334 memcpy(VarPtr(buffer[i3]), temp2, SizeOf ( Char) * length_num)342 memcpy(VarPtr(buffer[i3]), temp2, SizeOf (StrChar) * length_num) 335 343 Else 336 344 buffer[i3] = &H30 … … 367 375 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum]) 368 376 memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _ 369 SizeOf ( Char) * lstrlen(_System_UsingStrData[ParmNum]))377 SizeOf (StrChar) * lstrlen(_System_UsingStrData[ParmNum])) 370 378 i3 += lstrlen(_System_UsingStrData[ParmNum]) 371 379 ElseIf UsingStr[i2]=Asc("&") Then … … 385 393 _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ") 386 394 End If 387 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf ( Char) * i5)395 memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5) 388 396 i3 += i4 389 397 Else … … 423 431 RecodeNumber-- 424 432 425 SetFilePointer(_System_hFile(FileNumber), RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)426 lpBuffer =ZeroString(_System_FieldSize(FileNumber))427 ReadFile(_System_hFile(FileNumber), StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)433 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN) 434 lpBuffer = ZeroString(_System_FieldSize(FileNumber)) 435 ReadFile(_System_hFile(FileNumber), StrPtr(lpBuffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte),ByVal 0) 428 436 If Not dwAccessByte=_System_FieldSize(FileNumber) Then 429 lpBuffer =Left$(lpBuffer,dwAccessByte)437 lpBuffer = Left$(lpBuffer, dwAccessByte) 430 438 End If 431 439 End Macro … … 436 444 RecodeNumber-- 437 445 438 SetFilePointer(_System_hFile(FileNumber), RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN)439 WriteFile(_System_hFile(FileNumber), StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL)446 SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN) 447 WriteFile(_System_hFile(FileNumber), StrPtr(lpBuffer),SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0) 440 448 End Macro 441 449 442 450 Macro CHDIR(path As String) 443 SetCurrentDirectory( path)451 SetCurrentDirectory(ToTCStr(path)) 444 452 End Macro 445 453 Macro MKDIR(path As String) 446 CreateDirectory( path, 0)454 CreateDirectory(ToTCStr(path), 0) 447 455 End Macro 448 456 Macro KILL(path As String) 449 DeleteFile( path)457 DeleteFile(ToTCStr(path)) 450 458 End Macro 451 459 -
Include/basic/dos_console.sbp
r123 r142 20 20 Dim i As Long, i2 As Long, i3 As Long 21 21 Dim buf As String 22 Dim Input Str[1023] As Byte22 Dim InputBuf[1023] As TCHAR 23 23 Dim dwAccessBytes As DWord 24 24 … … 28 28 29 29 '入力 30 ReadConsole(_System_hConsoleIn, Input Str, Len(InputStr), dwAccessBytes, 0)31 If Input Str[dwAccessBytes-2] = &h0d And InputStr[dwAccessBytes-1] = &h0a Then32 Input Str[dwAccessBytes-2] = 030 ReadConsole(_System_hConsoleIn, InputBuf, Len(InputBuf), dwAccessBytes, 0) 31 If InputBuf[dwAccessBytes-2] = &h0d And InputBuf[dwAccessBytes-1] = &h0a Then 32 InputBuf[dwAccessBytes-2] = 0 33 33 End If 34 Dim InputStr As String(InputBuf) 34 35 35 36 'データを変数に格納 … … 59 60 i++ 60 61 If _System_InputDataPtr[i]=0 And InputStr[i2]=comma Then 61 PRINT_ToPrompt( "入力データの個数が多すぎます"+Chr$(10))62 PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n") 62 63 Goto *InputReStart 63 64 ElseIf InputStr[i2]=0 Then 64 65 If _System_InputDataPtr[i]<>0 Then 65 PRINT_ToPrompt( "入力データの個数が足りません"+Chr$(10))66 PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n") 66 67 Goto *InputReStart 67 68 Else … … 80 81 Sub PRINT_ToPrompt(buf As String) 81 82 Dim dwAccessBytes As DWord 83 #ifdef __STRING_UNICODE_WINDOWS_ANSI 84 ' Debug 85 Dim oldAlloc = _System_AllocForConvertedString 86 _System_AllocForConvertedString = AddressOf (_System_malloc) 87 Dim pszOut As PCSTR 88 Dim len = GetStr(buf, pszOut) 89 _System_AllocForConvertedString = oldAlloc 90 WriteConsole(_System_hConsoleOut, pszOut, len, dwAccessBytes, 0) 91 _System_free(pszOut) 92 #else 82 93 WriteConsole(_System_hConsoleOut, buf.Chars, buf.Length, dwAccessBytes, 0) 94 #endif 83 95 End Sub 84 96 -
Include/basic/function.sbp
r137 r142 344 344 '------------ 345 345 346 Function Asc(buf As * Char) AsChar346 Function Asc(buf As *StrChar) As StrChar 347 347 Asc = buf[0] 348 348 End Function 349 349 350 Function Chr$(code As Char) As String350 Function Chr$(code As StrChar) As String 351 351 Chr$ = ZeroString(1) 352 352 Chr$[0] = code 353 353 End Function 354 354 355 #if defUNICODE355 #ifndef __STRING_IS_NOT_UNICODE 356 356 Function AscW(s As *WCHAR) As UCSCHAR 357 357 If s.Length = 0 Then … … 487 487 488 488 Mid$=ZeroString(ReadLength) 489 memcpy(StrPtr(Mid$), VarPtr(buf [StartPos]), SizeOf (Char) * ReadLength)489 memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (Char) * ReadLength) 490 490 End Function 491 491 … … 515 515 If i>length Then 516 516 Right$=ZeroString(length) 517 memcpy(StrPtr(Right$), VarPtr(buf [i-length]), SizeOf (Char) * length)517 memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (Char) * length) 518 518 Else 519 519 Right$=buf … … 691 691 Return MakeStr(buffer) 692 692 End Function 693 Function Str$(value As LONG_PTR) As String693 Function Str$(value As Int64) As String 694 694 Dim temp[255] As Char 695 #ifdef _WIN64696 695 _sntprintf(temp, Len (temp) \ SizeOf (Char), "%I64d", value) 697 #else698 _sntprintf(temp, Len (temp) \ SizeOf (Char), "%d", value)699 #endif700 696 Str$ = temp 701 697 End Function … … 881 877 882 878 Function Lof(FileNum As Long) As Long 883 Lof =GetFileSize(_System_hFile(FileNum-1),NULL)879 Lof = GetFileSize(_System_hFile(FileNum-1), 0) 884 880 End Function 885 881 … … 1059 1055 End Function 1060 1056 1057 '-------- 1058 ' 文字列関数その2 1059 '-------- 1061 1060 Function _System_IsSurrogatePair(wcHigh As WCHAR, wcLow As WCHAR) As Boolean 1062 1061 If &hD800 <= wcHigh And wcHigh < &hDC00 Then … … 1068 1067 End Function 1069 1068 1070 Function _System_IsDoubleUnitChar(lead As Char, trail As Char) As Boolean 1071 #ifdef UNICODE 1069 Function _System_IsDoubleUnitChar(lead As WCHAR, trail As WCHAR) As Boolean 1072 1070 Return _System_IsSurrogatePair(lead, trail) 1073 #else 1071 End Function 1072 1073 Function _System_IsDoubleUnitChar(lead As SByte, trail As SByte) As Boolean 1074 1074 Return IsDBCSLeadByte(lead) <> FALSE 1075 #endif 1076 End Function 1077 1078 Sub _System_FillChar(p As *Char, n As SIZE_T, c As Char) 1075 End Function 1076 1077 Sub _System_FillChar(p As PWSTR, n As SIZE_T, c As WCHAR) 1079 1078 Dim i As SIZE_T 1080 1079 For i = 0 To ELM(n) … … 1083 1082 End Sub 1084 1083 1085 Function _System_ASCII_IsUpper(c As Char) As Boolean 1084 Sub _System_FillChar(p As PSTR, n As SIZE_T, c As SByte) 1085 Dim i As SIZE_T 1086 For i = 0 To ELM(n) 1087 p[i] = c 1088 Next 1089 End Sub 1090 1091 Function _System_ASCII_IsUpper(c As WCHAR) As Boolean 1086 1092 Return c As DWord - &h41 < 26 ' &h41 = Asc("A") 1087 1093 End Function 1088 1094 1095 Function _System_ASCII_IsUpper(c As SByte) As Boolean 1096 Return _System_ASCII_IsUpper(c As Byte As WCHAR) 1097 End Function 1098 1099 Function _System_ASCII_IsLower(c As WCHAR) As Boolean 1100 Return c As DWord - &h61 < 26 ' &h61 = Asc("a") 1101 End Function 1102 1089 1103 Function _System_ASCII_IsLower(c As Char) As Boolean 1090 Return c As DWord - &h61 < 26 ' &h61 = Asc("a")1091 End Function 1092 1093 Function _System_ASCII_ToLower(c As Char) As Char1104 Return _System_ASCII_IsLower(c As Byte As WCHAR) 1105 End Function 1106 1107 Function _System_ASCII_ToLower(c As WCHAR) As WCHAR 1094 1108 If _System_ASCII_IsUpper(c) Then 1095 1109 Return c Or &h20 … … 1097 1111 Return c 1098 1112 End If 1113 End Function 1114 1115 Function _System_ASCII_ToLower(c As SByte) As SByte 1116 Return _System_ASCII_ToLower(c As Byte As WCHAR) As Byte As SByte 1099 1117 End Function 1100 1118 … … 1107 1125 End Function 1108 1126 1109 Function _System_WideCharToMultiByte(s As PCWSTR) As PSTR 1110 Return _System_WideCharToMultiByte(s, lstrlenW(s) + 1, 0) 1111 End Function 1112 1113 Function _System_WideCharToMultiByte(s As PCWSTR, size As Long) As PSTR 1114 Return _System_WideCharToMultiByte(s, size, 0) 1115 End Function 1116 1117 Function _System_WideCharToMultiByte(ws As PCWSTR, size As Long, flag As DWord) As PSTR 1118 Dim sizeMBS = WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, 0, 0, 0, 0) 1119 Dim mbs = _System_malloc(sizeMBS) As PSTR 1120 WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS, 0, 0) 1121 Return mbs 1122 End Function 1123 1124 Function _System_MultiByteToWideChar(s As PCSTR) As PWSTR 1125 Return _System_MultiByteToWideChar(s, lstrlenA(s) + 1, 0) 1126 End Function 1127 1128 Function _System_MultiByteToWideChar(s As PCSTR, size As Long) As PWSTR 1129 Return _System_MultiByteToWideChar(s, size, 0) 1130 End Function 1131 1132 Function _System_MultiByteToWideChar(s As PCSTR, size As Long, flag As DWord) As PWSTR 1133 Dim sizeMBS = MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, 0, 0) 1134 Dim mbs = _System_malloc(SizeOf (WCHAR) * sizeMBS) As PWSTR 1135 MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS) 1136 Return mbs 1137 End Function 1127 Function _System_ASCII_ToUpper(c As SByte) As SByte 1128 Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte 1129 End Function 1130 1138 1131 1139 1132 Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long … … 1158 1151 _System_StrCmp = s1[i] - s2[i] 1159 1152 End Function 1153 1160 1154 #endif '_INC_FUNCTION -
Include/basic/prompt.sbp
r137 r142 8 8 #require <api_imm.sbp> 9 9 #require <Classes/System/Math.ab> 10 11 Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCSTR, cb As Long, ByRef Size As SIZE) As Long 12 _PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32A(hdc, psz, cb, Size) 13 End Function 14 15 Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCWSTR, cb As Long, ByRef Size As SIZE) As Long 16 _PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32W(hdc, psz, cb, Size) 17 End Function 18 19 Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long 20 _PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb) 21 End Function 22 23 Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCWSTR, cb As Long) As Long 24 _PromptSys_TextOut = TextOutW(hdc, x, y, psz, cb) 25 End Function 26 27 Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PSTR, bufLen As DWord) As Long 28 _PromptSys_ImmGetCompositionString = ImmGetCompositionStringA(himc, index, pBuf, bufLen) 29 End Function 30 31 Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PWSTR, bufLen As DWord) As Long 32 _PromptSys_ImmGetCompositionString = ImmGetCompositionStringW(himc, index, pBuf, bufLen) 33 End Function 10 34 11 35 Dim _PromptSys_hWnd As HWND … … 22 46 Type _PromptSys_LineInformation 23 47 Length As Long 24 Text As * Char48 Text As *StrChar 25 49 CharInfo As *_PromptSys_CharacterInformation 26 50 End Type … … 29 53 Dim _PromptSys_hFont As HFONT 30 54 Dim _PromptSys_FontSize As SIZE 31 Dim _PromptSys_InputStr[255] As Char55 Dim _PromptSys_InputStr[255] As StrChar 32 56 Dim _PromptSys_InputLen As Long 33 57 Dim _PromptSys_KeyChar As Byte … … 38 62 Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION 39 63 64 Dim _System_OSVersionInfo As OSVERSIONINFO 40 65 41 66 _PromptSys_InputLen = -1 … … 48 73 49 74 _PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0) 50 CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) 75 Dim _PromptSys_hThread As HANDLE 76 _PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) 77 If _PromptSys_hThread = 0 Then 78 Debug 79 ExitProcess(1) 80 End If 51 81 WaitForSingleObject(_PromptSys_hInitFinish, INFINITE) 52 82 … … 68 98 Next 69 99 _PromptSys_TextLine[100].Length = 0 70 _PromptSys_TextLine[100].Text = _System_calloc(SizeOf ( Char) * 255)100 _PromptSys_TextLine[100].Text = _System_calloc(SizeOf (StrChar) * 255) 71 101 _PromptSys_TextLine[100].CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255) 72 102 _PromptSys_CurPos.y-- … … 83 113 Dim sz As SIZE 84 114 i3 = _PromptSys_TextLine[i].Length 85 GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)115 _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz) 86 116 87 117 BitBlt(hDC,_ … … 106 136 End If 107 137 With _PromptSys_FontSize 108 TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]), tempLen)138 _PromptSys_TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]) As *StrChar, tempLen) 109 139 End With 110 140 i2 += tempLen … … 127 157 Dim doubleUnitChar = False As Boolean 128 158 'Addition 129 Dim i2 = 0 As Long, i3 As Long ' : Debug159 Dim i2 = 0 As Long, i3 As Long 130 160 For i2 = 0 To ELM(bufLen) 131 161 If buf[i2] = &h0d Then 'CR \r … … 158 188 charLen = 1 159 189 EndIf 160 GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]), charLen, sz)190 _PromptSys_GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]) As *StrChar, charLen, sz) 161 191 currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx 162 192 /* … … 305 335 TempStr = Ex"\r\n" 306 336 ElseIf wParam = &H16 Then 337 /* 307 338 'Paste Command(Use Clippboard) 308 339 OpenClipboard(hwnd) … … 324 355 GlobalUnlock(hGlobal) 325 356 CloseClipboard() 357 */ 326 358 Else 327 359 _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte … … 337 369 End If 338 370 End Sub 371 372 Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long 373 Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 374 rpsz = _System_malloc(size) As PTSTR 375 If rpsz = 0 Then 376 'Debug 377 Return 0 378 End If 379 Return ImmGetCompositionStringW(himc, GCS_RESULTSTR, rpsz, size) 380 End Function 381 382 Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long 383 Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 384 rpsz = _System_malloc(size) As PTSTR 385 If rpsz = 0 Then 386 'Debug 387 Return 0 388 End If 389 Return ImmGetCompositionStringA(himc, GCS_RESULTSTR, rpsz, size) 390 End Function 339 391 340 392 Function _PromptWnd_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT … … 345 397 Return 0 346 398 End If 347 Dim size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 348 Dim str = _System_malloc(size) As PTSTR 349 If str = 0 Then 350 'Debug 351 Return 0 352 End If 353 ImmGetCompositionString(himc, GCS_RESULTSTR, str, size) 399 Dim tempStr As String 400 Dim str As *StrChar 401 #ifdef __STIRNG_IS_NOT_UNICODE 402 Dim size = _PromptWnd_GetCompositionStringA(himc, str) 403 tempStr.Assign(str, size) 404 #else 405 With _System_OSVersionInfo 406 ' GetCompositionStringW is not implimented in Windows 95 407 If .dwMajorVersion = 4 And .dwMinorVersion = 0 And .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then 408 Dim strA As PCSTR 409 Dim sizeA = _PromptWnd_GetCompositionStringA(himc, strA) 410 tempStr.AssignFromMultiByte(strA, sizeA) 411 Else 412 Dim size = _PromptWnd_GetCompositionStringW(himc, str) 413 tempStr.Assign(str, size \ SizeOf (WCHAR)) 414 End If 415 End With 416 #endif 354 417 ImmReleaseContext(hwnd, himc) 355 356 memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size)357 _PromptSys_InputLen += size \ SizeOf (Char)358 359 Dim tempStr As String(str, size \ SizeOf (Char))360 418 _System_free(str) 361 419 362 SendMessage(hwnd, WM_KILLFOCUS, 0, 0) 420 memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.Chars, SizeOf (StrChar) * tempStr.Length) 421 _PromptSys_InputLen += tempStr.Length 422 423 SendMessage(hwnd, WM_KILLFOCUS, 0, 0) : Debug 363 424 PRINT_ToPrompt(tempStr) 364 425 SendMessage(hwnd, WM_SETFOCUS, 0, 0) … … 371 432 372 433 Function PromptMain(dwData As Long) As Long 434 GetVersionEx(_System_OSVersionInfo) 435 373 436 Dim i As Long 374 375 437 'Allocate 376 438 For i = 0 To 100 377 439 With _PromptSys_TextLine[i] 378 440 .Length = 0 379 .Text = _System_calloc(SizeOf ( Char) * 255)441 .Text = _System_calloc(SizeOf (StrChar) * 255) 380 442 .CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255) 381 443 End With … … 515 577 '---------------------------------------------- 516 578 Sub INPUT_FromPrompt(ShowStr As String) 517 Dim i As Long ,i2 As Long, i3 As Long579 Dim i As Long, i2 As Long, i3 As Long 518 580 Dim buf As String 519 581
Note:
See TracChangeset
for help on using the changeset viewer.