Changeset 411 for trunk/Include
- Timestamp:
- Feb 23, 2008, 5:37:00 PM (17 years ago)
- Location:
- trunk/Include
- Files:
-
- 3 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Include/Classes/ActiveBasic/Windows/CriticalSection.ab
r337 r411 9 9 10 10 Class CriticalSection 11 ' Inherits System.IDisposable11 Implements System.IDisposable 12 12 Public 13 13 Sub CriticalSection() … … 20 20 End Sub 21 21 22 /*Override*/Sub Dispose()22 Sub Dispose() 23 23 If InterlockedIncrement(disposed) = 0 Then 24 24 DeleteCriticalSection(cs) -
trunk/Include/Classes/System/Exception.ab
r391 r411 13 13 Const AB_E_NOTSUPPORTED = &h80041515 '80131515 14 14 Const AB_E_PLATFORMNOTSUPPORTED = &h80041539 '80131539 15 Const AB_E_KEYNOTFOUND = &h80041577 '80131577 15 16 16 17 End Namespace -
trunk/Include/Classes/index.ab
r403 r411 75 75 #require "./System/Security/AccessControl/misc.ab" 76 76 #require "./System/Text/StringBuilder.ab" 77 #require "./System/Text/Encoding.ab" 78 #require "./System/Text/UTF8Encoding.ab" 79 #require "./System/Text/DecoderFallback.ab" 77 80 #require "./System/Threading/Thread.ab" 78 81 #require "./System/Threading/WaitHandle.ab" -
trunk/Include/basic/prompt.sbp
r288 r411 4 4 #ifndef _INC_PROMPT 5 5 #define _INC_PROMPT 6 7 #require <api_imm.sbp>8 #require <Classes/System/Math.ab>9 #require <Classes/System/Environment.ab>10 6 11 7 Namespace ActiveBasic … … 23 19 Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long 24 20 _PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb) 21 If _PromptSys_TextOut = 0 Then Debug 25 22 End Function 26 23 … … 65 62 Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION 66 63 67 Dim _System_OSVersionInfo As OSVERSIONINFO68 69 64 70 65 'graphic … … 86 81 Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long) 87 82 Dim i As Long, i2 As Long, i3 As Long 83 Dim ret As Long 88 84 89 85 Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT … … 118 114 _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz) 119 115 120 BitBlt(hDC,_121 sz.cx, i * _PromptSys_FontSize.cy, _122 rc.right, _PromptSys_FontSize.cy, _123 _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY)116 ' BitBlt(hDC,_ 117 ' sz.cx, i * _PromptSys_FontSize.cy, _ 118 ' rc.right, _PromptSys_FontSize.cy, _ 119 ' _PromptSys_hMemDC, sz.cx, i * _PromptSys_FontSize.cy, SRCCOPY) 124 120 125 121 While i2 < i3 … … 128 124 SetBkMode(hDC, TRANSPARENT) 129 125 Else 130 SetBkMode(hDC, OPAQUE) 131 SetBkColor(hDC, currentLineCharInfo[i2].BackColor) 126 Debug 127 ret = SetBkMode(hDC, OPAQUE) 128 ret = SetBkColor(hDC, currentLineCharInfo[i2].BackColor) 132 129 End If 133 130 … … 152 149 153 150 Sub PRINT_ToPrompt(buf As String) 151 OutputDebugString(ToTCStr(Ex"PRINT_ToPrompt " + buf + Ex"\r\n")) 154 152 EnterCriticalSection(_PromptSys_SectionOfBufferAccess) 153 If buf = "あ" Then Debug 155 154 With _PromptSys_CurPos 156 155 Dim hdc = GetDC(_PromptSys_hWnd) 157 156 Dim hOldFont = SelectObject(hdc, _PromptSys_hFont) 158 Dim StartLine As Long : StartLine = .y157 Dim StartLine = .y As Long 159 158 Dim bufLen = buf.Length 160 159 Dim doubleUnitChar = False As Boolean … … 194 193 _PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *StrChar, charLen, sz) 195 194 currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx 196 /*197 Dim buf[1023] As Char198 wsprintf(buf, Ex"%d %d\r\n", currentLineCharInfo[.x + 1].StartPos, currentLineCharInfo[.x].StartPos + sz.cx)199 OutputDebugString(buf)200 */201 195 End If 202 196 End If … … 207 201 208 202 'Draw the text buffer added 209 DrawPromptBuffer(hdc, StartLine, .y) 203 'DrawPromptBuffer(hdc, StartLine, .y) 204 InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE) 205 UpdateWindow(_PromptSys_hWnd) 210 206 SelectObject(hdc, hOldFont) 211 207 ReleaseDC(_PromptSys_hWnd, hdc) … … 262 258 .cy = tm.tmHeight 263 259 End With 260 261 '_PromptSys_hFont initialize 262 Dim lf As LOGFONT 263 With lf 264 .lfHeight = -MulDiv(12, GetDeviceCaps(hdc, LOGPIXELSY), 72) 265 .lfWidth = 0 266 .lfEscapement = 0 267 .lfOrientation = 0 268 .lfWeight = 0 269 .lfItalic = 0 270 .lfUnderline = 0 271 .lfStrikeOut = 0 272 .lfCharSet = SHIFTJIS_CHARSET 273 .lfOutPrecision = OUT_DEFAULT_PRECIS 274 .lfClipPrecision = CLIP_DEFAULT_PRECIS 275 .lfQuality = DEFAULT_QUALITY 276 .lfPitchAndFamily = FIXED_PITCH 277 lstrcpy(.lfFaceName, ToTCStr("MS 明朝")) 278 End With 279 280 _PromptSys_hFont = CreateFontIndirect(lf) 264 281 265 282 ReleaseDC(hwnd, hdc) … … 378 395 Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long 379 396 Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 380 rpsz = _System_malloc(size) As PWSTR397 rpsz = GC_malloc(size) As PWSTR 381 398 If rpsz = 0 Then 382 399 'Debug … … 388 405 Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long 389 406 Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 390 rpsz = _System_malloc(size) As PSTR407 rpsz = GC_malloc(size) As PSTR 391 408 If rpsz = 0 Then 392 409 'Debug … … 423 440 #endif 424 441 ImmReleaseContext(hwnd, himc) 425 _System_free(str)426 442 427 443 ActiveBasic.Strings.ChrCopy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.StrPtr, tempStr.Length As SIZE_T) … … 439 455 440 456 Function PromptMain(dwData As Long) As Long 441 GetVersionEx(_System_OSVersionInfo)442 443 457 Dim i As Long 444 458 'Allocate … … 460 474 .cy = GetSystemMetrics(SM_CYSCREEN) 461 475 End With 462 463 '_PromptSys_hFont initialize464 Dim lf As LOGFONT465 With lf466 .lfHeight = -16467 .lfWidth = 0468 .lfEscapement = 0469 .lfOrientation = 0470 .lfWeight = 0471 .lfItalic = 0472 .lfUnderline = 0473 .lfStrikeOut = 0474 .lfCharSet = SHIFTJIS_CHARSET475 .lfOutPrecision = OUT_DEFAULT_PRECIS476 .lfClipPrecision = CLIP_DEFAULT_PRECIS477 .lfQuality = DEFAULT_QUALITY478 .lfPitchAndFamily = FIXED_PITCH479 lstrcpy(.lfFaceName, ToTCStr("MS 明朝"))480 End With481 482 _PromptSys_hFont = CreateFontIndirect(lf)483 476 484 477 'Critical Section … … 604 597 Goto *InputReStart 605 598 End If 606 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i] .ToString)599 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], broken[i]) 607 600 Next 608 601 … … 624 617 Dim i = _PromptSys_TextLine[y].Length 625 618 If i < x Then 626 _System_FillChar(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20 As StrChar) 'Asc(" ")619 ActiveBasic.Strings.ChrFill(VarPtr(_PromptSys_TextLine[y].Text[i]), x - i, &h20 As StrChar) 'Asc(" ") 627 620 Dim i2 As Long 628 621 For i2 = i To ELM(x) … … 664 657 Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2) 665 658 Else 666 Dim sw As Long659 Dim sw As Boolean 667 660 StartPos *=StartPos 668 661 EndPos *=EndPos 669 662 670 663 If StartPos<0 Or EndPos<0 Then 671 sw =1664 sw = True 672 665 Else 673 sw =0666 sw = False 674 667 End If 675 668 -
trunk/Include/objidl.sbp
r364 r411 131 131 End Interface 132 132 133 ' IExternalCennection 133 /* interface IExternalConnection */ 134 /* [uuid][local][object] */ 135 136 Const Enum EXTCONN 137 EXTCONN_STRONG = 1 138 EXTCONN_WEAK = 2 139 EXTCONN_CALLABLE = 4 140 End Enum 141 142 Dim IID_IExternalConnection = [&h00000019, 0, 0, [&hC0, 0, 0, 0, 0, 0, 0, &h46]] As IID 143 144 Interface IExternalConnection 145 Inherits IUnknown 146 147 Function AddConnection( 148 /* [in] */ extconn As DWord, 149 /* [in] */ reserved As DWord) As DWord 150 Function ReleaseConnection( 151 /* [in] */ extconn As DWord, 152 /* [in] */ reserved As DWord, 153 /* [in] */ fLastReleaseCloses As BOOL) As DWord 154 End Interface 134 155 135 156 Type MULTI_QI -
trunk/Include/system/exception.ab
r388 r411 28 28 29 29 Sub FinishFinally() 30 Imports System.Threading 30 31 If Thread.CurrentThread().__IsThrowing() Then 31 32 Throw Thread.CurrentThread().__GetThrowintParamObject() … … 34 35 35 36 Function ResolveCatchesOverload( ex As Object ) As LONG_PTR 37 OutputDebugString("ResolveCatchesOverload: ") 38 OutputDebugString(ToTCStr(ex.ToString)) 39 OutputDebugString(Ex"\r\n") 36 40 Dim defaultCatchCodePos = 0 As LONG_PTR 37 41 Dim pos = 0 As Long … … 66 70 Return defaultCatchCodePos 67 71 End Function 68 72 Private 69 73 Function isCatchable(paramName As String, catchType As System.TypeInfo) As Boolean 74 /* If Not String.IsNullOrEmpty(paramName) Then 75 Dim paramType = _System_TypeBase_Search(paramName) 76 isCatchable = ActiveBasic.Detail.IsBaseOf(catchType, paramType) 77 Else 78 isCatchable = False 79 End If 80 /*/ 70 81 isCatchable = False 71 82 While Not ActiveBasic.IsNothing(catchType) … … 77 88 catchType = catchType.BaseType 78 89 Wend 90 '*/ 79 91 End Function 80 92 End Class … … 112 124 113 125 Static Function BeginTryScope( catchTable As *LONG_PTR, addressOfFinally As VoidPtr, basePtr As LONG_PTR, stackPtr As LONG_PTR ) As TryLayer 114 Return _System_pobj_AllThreads->GetCurrentException() ->_BeginTryScope( catchTable, addressOfFinally, basePtr, stackPtr )126 Return _System_pobj_AllThreads->GetCurrentException()._BeginTryScope( catchTable, addressOfFinally, basePtr, stackPtr ) 115 127 End Function 116 128 … … 127 139 128 140 'TODO: 適切なエラー処理 129 MessageBox( NULL, "Catchされていない例外があります", NULL, MB_OK or MB_ICONEXCLAMATION )141 MessageBox( NULL, ToTCStr(Ex"Catchされていない例外があります\r\n" + ex.ToString), NULL, MB_OK or MB_ICONEXCLAMATION ) 130 142 Debug 131 143 Return … … 133 145 134 146 ' スレッドへThrow処理を開始したことを通知 147 Imports System.Threading 135 148 Thread.CurrentThread().__Throw( ex ) 136 149
Note:
See TracChangeset
for help on using the changeset viewer.