Changeset 691


Ignore:
Timestamp:
Mar 16, 2009, 8:34:59 AM (16 years ago)
Author:
イグトランス (egtra)
Message:

プロンプト画面のテキスト描画を、1文字ずつから、同じ色のテキストをまとめて書く方法へ変更。また、一部の制御コードに対応 (NUL, BEL, BS, HT, LF, FF, CR)。

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ab5.0/ablib/src/basic/prompt.sbp

    r688 r691  
    4242    ForeColor As COLORREF
    4343    BackColor As COLORREF
    44     StartPos As Long
    4544End Type
    4645
     
    7978End Sub
    8079
     80Sub DrawTextBlock(hdc As HDC, len As Long, p As PCTSTR, ci As *_PromptSys_CharacterInformation)
     81    If len = 0 Then
     82        Exit Sub
     83    End If
     84
     85    If ci[0].BackColor = -1 Then
     86        SetBkMode(hdc, TRANSPARENT)
     87    Else
     88        SetBkMode(hdc, OPAQUE)
     89        SetBkColor(hdc, ci[0].BackColor)
     90    End If
     91    SetTextColor(hdc, ci[0].ForeColor)
     92
     93    Dim i As Long
     94    For i = 0 To ELM(len)
     95        If ci[i].ForeColor <> ci[0].ForeColor Or ci[i].BackColor <> ci[0].BackColor Then
     96            TextOut(hdc, 0, 0, p, i)
     97            DrawTextBlock(hdc, len - 1, VarPtr(p[i]), VarPtr(ci[i]))
     98            Exit Sub
     99        End If
     100    Next
     101    TextOut(hdc, 0, 0, p, i)
     102End Sub
     103
    81104Sub DrawPromptBuffer(hDC As HDC, StartLine As Long, EndLine As Long)
    82     Dim i As Long, i2 As Long, i3 As Long
    83     Dim ret As Long
     105    Dim i As Long
    84106
    85107    Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT
     
    105127    Wend
    106128
    107     i = 0' : Debug
    108     While i * _PromptSys_FontSize.cy < rc.bottom and i <= 100
    109         If StartLine=-1 or (StartLine<=i and i<=EndLine) Then
    110             Dim currentLineCharInfo = _PromptSys_TextLine[i].CharInfo
    111 
    112             Dim sz As SIZE
    113             i3 = _PromptSys_TextLine[i].Length
    114             _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz)
    115 
    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)
    120 
    121             While i2 < i3
    122                 SetTextColor(hDC, currentLineCharInfo[i2].ForeColor)
    123                 If currentLineCharInfo[i2].BackColor = -1 Then
    124                     SetBkMode(hDC, TRANSPARENT)
    125                 Else
    126 '                   Debug
    127                     ret = SetBkMode(hDC, OPAQUE)
    128                     ret = SetBkColor(hDC, currentLineCharInfo[i2].BackColor)
    129                 End If
    130 
    131                 Dim tempLen As Long
    132                 If _System_IsDoubleUnitChar(_PromptSys_TextLine[i].Text[i2], _PromptSys_TextLine[i].Text[i2+1]) Then
    133                     tempLen = 2
    134                 Else
    135                     tempLen = 1
    136                 End If
    137                 With _PromptSys_FontSize
    138                     _PromptSys_TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]) As *Char, tempLen)
    139                 End With
    140                 i2 += tempLen
    141             Wend
    142         End If
    143 
     129    SetTextAlign(hDC, TA_LEFT Or TA_TOP Or TA_UPDATECP)
     130    i = 0
     131    While i * _PromptSys_FontSize.cy < rc.bottom And i <= 100
     132        If StartLine = -1 Or (StartLine <= i And i <= EndLine) Then
     133            With _PromptSys_TextLine[i]
     134                BitBlt(hDC,_
     135                    0, i * _PromptSys_FontSize.cy, _
     136                    rc.right, _PromptSys_FontSize.cy, _
     137                    _PromptSys_hMemDC, 0, i * _PromptSys_FontSize.cy, SRCCOPY)
     138                MoveToEx(hDC, 0, i * _PromptSys_FontSize.cy, ByVal 0)
     139                DrawTextBlock(hDC, .Length, .Text, .CharInfo)
     140            End With
     141        End If
    144142        i++
    145143    Wend
    146 
    147144    SelectObject(hDC, hOldFont)
    148145End Sub
    149146
    150147Sub PRINT_ToPrompt(buf As String)
    151     OutputDebugString(ToTCStr(Ex"PRINT_ToPrompt " + buf + Ex"\r\n"))
     148    System.Diagnostics.Debug.WriteLine("PRINT_ToPrompt: " + buf)
     149    PrintToPromptImpl(ToTCStr(buf), Len(buf))
     150End Sub
     151
     152/*
     153@brief PrintToPromptImplの内部関数
     154@date 2009/03/16
     155@author Egtra
     156出力行が変わるときに呼ばれる。
     157*/
     158Sub SetLineLength()
     159    _PromptSys_TextLine[_PromptSys_CurPos.y].Length = System.Math.Max(_PromptSys_TextLine[_PromptSys_CurPos.y].Length, _PromptSys_CurPos.x)
     160End Sub
     161
     162/*
     163@brief PrintToPromptImplの内部関数
     164@date 2009/03/16
     165@author Egtra
     1661文字を出力するときに呼ばれる。
     167*/
     168Sub PutCharToPrompt(c As Char)
     169    With _PromptSys_CurPos
     170        Dim current = _PromptSys_TextLine[.y]
     171        current.Text[.x] = c
     172        current.CharInfo[.x].ForeColor = _PromptSys_NowTextColor
     173        current.CharInfo[.x].BackColor = _PromptSys_NowBackColor
     174        .x++
     175    End With
     176End Sub
     177
     178Sub PrintToPromptImpl(p As PCTSTR, len As Long)
    152179    EnterCriticalSection(_PromptSys_SectionOfBufferAccess)
    153     If buf = "あ" Then Debug
    154     With _PromptSys_CurPos
    155         Dim hdc = GetDC(_PromptSys_hWnd)
    156         Dim hOldFont = SelectObject(hdc, _PromptSys_hFont)
    157         Dim StartLine = .y As Long
    158         Dim bufLen = buf.Length
    159         Dim doubleUnitChar = False As Boolean
    160         'Addition
    161         Dim i2 = 0 As Long, i3 As Long
    162         For i2 = 0 To ELM(bufLen)
    163             If buf[i2] = &h0d Then 'CR \r
    164                 _PromptSys_TextLine[.y].Length = .x
    165                 .x = 0
    166             ElseIf buf[i2] = &h0a Then 'LF \n
    167                 _PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)
    168                 .y++
    169             Else
    170                 Dim currentLineCharInfo = _PromptSys_TextLine[.y].CharInfo
    171                 _PromptSys_TextLine[.y].Text[.x] = buf[i2]
    172                 currentLineCharInfo[.x].ForeColor = _PromptSys_NowTextColor
    173                 currentLineCharInfo[.x].BackColor = _PromptSys_NowBackColor
    174 
    175                 If buf[i2] = &h09 Then 'tab
    176                     Dim tabStop = _PromptSys_FontSize.cx * 8
    177                     currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + _
    178                         tabStop - currentLineCharInfo[.x].StartPos Mod tabStop
    179                 Else
    180                     If doubleUnitChar <> False Then
    181                         doubleUnitChar = False
    182                         currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos
    183                     Else
    184                         Dim sz As SIZE
    185                         Dim charLen As Long
    186                         If _System_IsDoubleUnitChar(buf[i2], buf[i2 + 1]) Then
    187                             charLen = 2
    188                             doubleUnitChar = True
    189                         Else
    190                             charLen = 1
    191                         EndIf
    192                         Dim p = buf.StrPtr
    193                         _PromptSys_GetTextExtentPoint32(hdc, VarPtr(p[i2]) As *Char, charLen, sz)
    194                         currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx
    195                     End If
    196                 End If
    197                 .x++
    198             End If
    199         Next
    200         _PromptSys_TextLine[.y].Length = System.Math.Max(_PromptSys_TextLine[.y].Length, .x)
    201 
    202         'Draw the text buffer added
    203         'DrawPromptBuffer(hdc, StartLine, .y)
    204         InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE)
    205         UpdateWindow(_PromptSys_hWnd)
    206         SelectObject(hdc, hOldFont)
    207         ReleaseDC(_PromptSys_hWnd, hdc)
    208     End With
     180    Dim leadByte = False
     181    'Addition
     182    Dim i = 0 As Long
     183    For i = 0 To ELM(len)
     184        If leadByte Then
     185            PutCharToPrompt(p[i])
     186        Else
     187            With _PromptSys_CurPos
     188                Select Case p[i]
     189                    Case 13 'CR \r 復帰
     190                        SetLineLength()
     191                        .x = 0
     192                    Case 12 'FF フォームフィード
     193                        Cls 1
     194                    Case 10 'LF 改行
     195                        SetLineLength()
     196                        .y++
     197                    Case 9 'HT 水平タブ
     198                        Dim j As Long
     199                        For j = (.x And 7) To ELM(8)
     200                            PutCharToPrompt(&h20) '空白
     201                        Next
     202                    Case 8 'BS 後退
     203                        .x--
     204                    Case 7 'BEL ベル
     205                        MessageBeep(MB_ICONHAND) 'PuTTY由来のアイディア
     206                    Case 0 'NUL 空文字
     207                    Case Else
     208                        PutCharToPrompt(p[i])
     209                        If IsDBCSLeadByte(p[i]) Then
     210                            leadByte = True
     211                        End If
     212                End Select
     213            End With
     214        End If
     215    Next
     216    SetLineLength()
     217
    209218    LeaveCriticalSection(_PromptSys_SectionOfBufferAccess)
     219
     220    InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE)
     221    UpdateWindow(_PromptSys_hWnd)
    210222End Sub
    211223
     
    313325        CreateCaret(hwnd, 0, 9, 6)
    314326        With _PromptSys_CurPos
    315             SetCaretPos(_PromptSys_TextLine[.y].CharInfo[.x].StartPos, (.y + 1) * _PromptSys_FontSize.cy - 7)
     327            SetCaretPos(.x * _PromptSys_FontSize.cx, (.y + 1) * _PromptSys_FontSize.cy - 7)
    316328        End With
    317329        ShowCaret(hwnd)
Note: See TracChangeset for help on using the changeset viewer.