- Timestamp:
- 2009/03/16 08:34:59 (3 years ago)
- File:
-
- 1 edited
-
trunk/ab5.0/ablib/src/basic/prompt.sbp (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ab5.0/ablib/src/basic/prompt.sbp
r688 r691 42 42 ForeColor As COLORREF 43 43 BackColor As COLORREF 44 StartPos As Long45 44 End Type 46 45 … … 79 78 End Sub 80 79 80 Sub 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) 102 End Sub 103 81 104 Sub 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 84 106 85 107 Dim hOldFont = SelectObject(hDC, _PromptSys_hFont) As HFONT … … 105 127 Wend 106 128 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 144 142 i++ 145 143 Wend 146 147 144 SelectObject(hDC, hOldFont) 148 145 End Sub 149 146 150 147 Sub 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)) 150 End Sub 151 152 /* 153 @brief PrintToPromptImplの内部関数 154 @date 2009/03/16 155 @author Egtra 156 出力行が変わるときに呼ばれる。 157 */ 158 Sub SetLineLength() 159 _PromptSys_TextLine[_PromptSys_CurPos.y].Length = System.Math.Max(_PromptSys_TextLine[_PromptSys_CurPos.y].Length, _PromptSys_CurPos.x) 160 End Sub 161 162 /* 163 @brief PrintToPromptImplの内部関数 164 @date 2009/03/16 165 @author Egtra 166 1文字を出力するときに呼ばれる。 167 */ 168 Sub 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 176 End Sub 177 178 Sub PrintToPromptImpl(p As PCTSTR, len As Long) 152 179 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 209 218 LeaveCriticalSection(_PromptSys_SectionOfBufferAccess) 219 220 InvalidateRect(_PromptSys_hWnd, ByVal 0, TRUE) 221 UpdateWindow(_PromptSys_hWnd) 210 222 End Sub 211 223 … … 313 325 CreateCaret(hwnd, 0, 9, 6) 314 326 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) 316 328 End With 317 329 ShowCaret(hwnd)
Note: See TracChangeset
for help on using the changeset viewer.
