Changeset 685 for trunk

Timestamp:

Mar 9, 2009, 9:33:12 PM (15 years ago)

Author:

イグトランス (egtra)

Message:

Cls及び初期化時の塗り潰しをExtTextOutで行うよう変更

File:

• trunk/ab5.0/ablib/src/basic/prompt.sbp (modified) (3 diffs)

trunk/ab5.0/ablib/src/basic/prompt.sbp

@@ -244 +244 @@
 
     'Initialize for Win9x
-    Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH)) As HBRUSH
-    With _PromptSys_ScreenSize
-        PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
-    End With
-    SelectObject(_PromptSys_hMemDC, hOldBrush)
+    ClearGraphicsScreen()
 
     Dim tm As TEXTMETRIC
@@ -531 +527 @@
 End Function
 
+Sub ClearGraphicsScreen()
+    Dim rc As RECT
+    With rc
+        .left = 0
+        .top = 0
+        .right = _PromptSys_ScreenSize.cx
+        .bottom = _PromptSys_ScreenSize.cy
+    End With
+    SetBkColor(_PromptSys_hMemDC, 0)
+    ExtTextOut(_PromptSys_hMemDC, 0, 0, ETO_OPAQUE, rc, "", 0, 0) '矩形塗り潰しはExtTextOutが速いらしい
+End Sub
+
 'Prompt text command functoins
 
@@ -555 +563 @@
     If n = 2 Or n = 3 Then
         'Clear the graphics screen
-        Dim hOldBrush = SelectObject(_PromptSys_hMemDC, GetStockObject(BLACK_BRUSH))
-        With _PromptSys_ScreenSize
-            PatBlt(_PromptSys_hMemDC, 0, 0, .cx, .cy, PATCOPY)
-        End With
-        SelectObject(_PromptSys_hMemDC, hOldBrush)
+        ClearGraphicsScreen()
     End If