Changeset 411


Ignore:
Timestamp:
Feb 23, 2008, 5:37:00 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

UTF8Encoding（仮）の追加

Location:
trunk
Files:
4 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/Classes/ActiveBasic/Windows/CriticalSection.ab

    r337 r411  
    99
    1010Class CriticalSection
    11 '   Inherits System.IDisposable
     11    Implements System.IDisposable
    1212Public
    1313    Sub CriticalSection()
    … …  
    2020    End Sub
    2121
    22     /*Override*/ Sub Dispose()
     22    Sub Dispose()
    2323        If InterlockedIncrement(disposed) = 0 Then
    2424            DeleteCriticalSection(cs)

  • trunk/Include/Classes/System/Exception.ab

    r391 r411  
    1313Const AB_E_NOTSUPPORTED = &h80041515 '80131515
    1414Const AB_E_PLATFORMNOTSUPPORTED = &h80041539 '80131539
     15Const AB_E_KEYNOTFOUND = &h80041577 '80131577
    1516
    1617End Namespace

  • trunk/Include/Classes/index.ab

    r403 r411  
    7575#require "./System/Security/AccessControl/misc.ab"
    7676#require "./System/Text/StringBuilder.ab"
     77#require "./System/Text/Encoding.ab"
     78#require "./System/Text/UTF8Encoding.ab"
     79#require "./System/Text/DecoderFallback.ab"
    7780#require "./System/Threading/Thread.ab"
    7881#require "./System/Threading/WaitHandle.ab"

  • trunk/Include/basic/prompt.sbp

    r288 r411  
    44#ifndef _INC_PROMPT
    55#define _INC_PROMPT
    6 
    7 #require <api_imm.sbp>
    8 #require <Classes/System/Math.ab>
    9 #require <Classes/System/Environment.ab>
    106
    117Namespace ActiveBasic
    … …  
    2319Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long
    2420    _PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb)
     21    If _PromptSys_TextOut = 0 Then Debug
    2522End Function
    2623
    … …  
    6562Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION
    6663
    67 Dim _System_OSVersionInfo As OSVERSIONINFO
    68 
    6964
    7065'graphic
    … …  
    8681Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
    8782    Dim i As Long, i2 As Long, i3 As Long
     83    Dim ret As Long
    8884
    8985    Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
    … …  
    118114            _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)
    119115
    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)
    124120
    125121            While i2 < i3
    … …  
    128124                    SetBkMode(hDC, TRANSPARENT)
    129125                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)
    132129                End If
    133130
    … …  
    152149
    153150Sub PRINT_ToPrompt(buf As String)
     151    OutputDebugString(ToTCStr(Ex"PRINT_ToPrompt " + buf + Ex"\r\n"))
    154152    EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
     153    If buf = "あ" Then Debug
    155154    With _PromptSys_CurPos
    156155        Dim hdc = GetDC(_PromptSys_hWnd)
    157156        Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
    158         Dim StartLine As Long : StartLine = .y
     157        Dim StartLine = .y As Long
    159158        Dim bufLen = buf.Length
    160159        Dim doubleUnitChar = False As Boolean
    … …  
    194193                        _PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *StrChar, charLen, sz)
    195194                        currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
    196 /*
    197                         Dim buf[1023] As Char
    198                         wsprintf(buf, Ex"%d %d\r\n", currentLineCharInfo[.x + 1].StartPos, currentLineCharInfo[.x].StartPos + sz.cx)
    199                         OutputDebugString(buf)
    200 */
    201195                    End If
    202196                End If
    … …  
    207201
    208202        '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)
    210206        SelectObject(hdc, hOldFont)
    211207        ReleaseDC(_PromptSys_hWnd, hdc)
    … …  
    262258        .cy = tm.tmHeight
    263259    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("ＭＳ 明朝"))
     278    End With
     279
     280    _PromptSys_hFont = CreateFontIndirect(lf)
    264281
    265282    ReleaseDC(hwnd, hdc)
    … …  
    378395Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long
    379396    Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
    380     rpsz = _System_malloc(size) As PWSTR
     397    rpsz = GC_malloc(size) As PWSTR
    381398    If rpsz = 0 Then
    382399        'Debug
    … …  
    388405Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long
    389406    Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位
    390     rpsz = _System_malloc(size) As PSTR
     407    rpsz = GC_malloc(size) As PSTR
    391408    If rpsz = 0 Then
    392409        'Debug
    … …  
    423440#endif
    424441        ImmReleaseContext(hwnd, himc)
    425         _System_free(str)
    426442
    427443        ActiveBasic.Strings.ChrCopy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.StrPtr, tempStr.Length As SIZE_T)
    … …  
    439455
    440456Function PromptMain(dwData As Long) As Long
    441     GetVersionEx(_System_OSVersionInfo)
    442 
    443457    Dim i As Long
    444458    'Allocate
    … …  
    460474        .cy = GetSystemMetrics(SM_CYSCREEN)
    461475    End With
    462 
    463     '_PromptSys_hFont initialize
    464     Dim lf As LOGFONT
    465     With lf
    466         .lfHeight = -16
    467         .lfWidth = 0
    468         .lfEscapement = 0
    469         .lfOrientation = 0
    470         .lfWeight = 0
    471         .lfItalic = 0
    472         .lfUnderline = 0
    473         .lfStrikeOut = 0
    474         .lfCharSet = SHIFTJIS_CHARSET
    475         .lfOutPrecision = OUT_DEFAULT_PRECIS
    476         .lfClipPrecision = CLIP_DEFAULT_PRECIS
    477         .lfQuality = DEFAULT_QUALITY
    478         .lfPitchAndFamily = FIXED_PITCH
    479         lstrcpy(.lfFaceName, ToTCStr("ＭＳ 明朝"))
    480     End With
    481 
    482     _PromptSys_hFont = CreateFontIndirect(lf)
    483476
    484477    'Critical Section
    … …  
    604597            Goto *InputReStart
    605598        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])
    607600    Next
    608601
    … …  
    624617    Dim i = _PromptSys_TextLine[y].Length
    625618    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(" ")
    627620        Dim i2 As Long
    628621        For i2 = i To ELM(x)
    … …  
    664657        Ellipse(_PromptSys_hMemDC,x-radius,y-radi2,x+radius,y+radi2)
    665658    Else
    666         Dim sw As Long
     659        Dim sw As Boolean
    667660        StartPos *=StartPos
    668661        EndPos *=EndPos
    669662
    670663        If StartPos<0 Or EndPos<0 Then
    671             sw=1
     664            sw = True
    672665        Else
    673             sw=0
     666            sw = False
    674667        End If
    675668

  • trunk/Include/objidl.sbp

    r364 r411  
    131131End Interface
    132132
    133 ' IExternalCennection
     133/* interface IExternalConnection */
     134/* [uuid][local][object] */
     135
     136Const Enum EXTCONN
     137    EXTCONN_STRONG = 1
     138    EXTCONN_WEAK = 2
     139    EXTCONN_CALLABLE = 4
     140End Enum
     141
     142Dim IID_IExternalConnection = [&h00000019, 0, 0, [&hC0, 0, 0, 0, 0, 0, 0, &h46]] As IID
     143
     144Interface 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
     154End Interface
    134155
    135156Type MULTI_QI

  • trunk/Include/system/exception.ab

    r388 r411  
    2828
    2929    Sub FinishFinally()
     30        Imports System.Threading
    3031        If Thread.CurrentThread().__IsThrowing() Then
    3132            Throw Thread.CurrentThread().__GetThrowintParamObject()
    … …  
    3435
    3536    Function ResolveCatchesOverload( ex As Object ) As LONG_PTR
     37        OutputDebugString("ResolveCatchesOverload: ")
     38        OutputDebugString(ToTCStr(ex.ToString))
     39        OutputDebugString(Ex"\r\n")
    3640        Dim defaultCatchCodePos = 0 As LONG_PTR
    3741        Dim pos = 0 As Long
    … …  
    6670        Return defaultCatchCodePos
    6771    End Function
    68 
     72Private
    6973    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/*/
    7081        isCatchable = False
    7182        While Not ActiveBasic.IsNothing(catchType)
    … …  
    7788            catchType = catchType.BaseType
    7889        Wend
     90'*/
    7991    End Function
    8092End Class
    … …  
    112124
    113125    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 )
    115127    End Function
    116128
    … …  
    127139
    128140            '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 )
    130142            Debug
    131143            Return
    … …  
    133145
    134146        ' スレッドへThrow処理を開始したことを通知
     147        Imports System.Threading
    135148        Thread.CurrentThread().__Throw( ex )
    136149

  • trunk/TestCase/SimpleTestCase/PathTest.ab

    r388 r411  
    3939
    4040End Namespace
    41 Try
     41
    4242PathTest.TestMain()
    43 Catch e As System.Exception
    44     Debug
    45     Print e.ToString()
    46 End Try

  • trunk/TestCase/SimpleTestCase/SimpleTestCase.idx

    r403 r411  
    3232#include "TypeInfoTest.ab"
    3333_ClearNamespaceImported
     34#include "EncodingTest.ab"
     35_ClearNamespaceImported

  • trunk/TestCase/SimpleTestCase/SimpleTestCase.pj

    r403 r411  
    2323#DEBUG_EXE_PATH=
    2424
    25 #RESOURCE=0
     25#RESOURCE=SimpleTestCase.rc
    2626
    2727#SOURCE
    … …  
    4141ExceptionTest.ab
    4242TypeInfoTest.ab
     43EncodingTest.ab
Note: See TracChangeset for help on using the changeset viewer.