Render ExtTextOut directly to screen DC, eliminating memory DC intermediate
The MemDC + BitBlt approach wrote every pixel twice (ExtTextOut to system memory, then BitBlt to video memory). Now ExtTextOut renders directly to the CS_OWNDC screen DC, letting the display driver write text straight into the framebuffer via its optimized raster font path. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
parent
a7780c8030
commit
78753a65d8
1 changed files with 47 additions and 102 deletions
|
|
@ -7,11 +7,11 @@ unit KPAnsi;
|
|||
{ Renders incoming data using standard ANSI/VT100 escape sequences for }
|
||||
{ cursor positioning, color attributes, and screen manipulation. }
|
||||
{ }
|
||||
{ Rendering uses ExtTextOut into a memory DC with color-run batching, then }
|
||||
{ BitBlt to the screen. The memory bitmap is in native device format, so }
|
||||
{ BitBlt is a raw copy with no color conversion. Smart blink tracking }
|
||||
{ dirties only cursor and blink rows instead of the entire screen, }
|
||||
{ eliminating wasteful full repaints. }
|
||||
{ Rendering uses ExtTextOut with color-run batching directly to the screen }
|
||||
{ DC (CS_OWNDC retains the selected OEM font across GetDC calls). No }
|
||||
{ intermediate bitmap -- the display driver renders text directly into the }
|
||||
{ framebuffer via its optimized raster font path. Smart blink tracking }
|
||||
{ dirties only cursor and blink rows instead of the entire screen. }
|
||||
{ }
|
||||
{ Installs to the "KP" palette tab alongside TKPComm. }
|
||||
|
||||
|
|
@ -103,18 +103,12 @@ type
|
|||
FScrollbarDirty: Boolean; { True = scrollbar range/position needs update }
|
||||
FTextBlinkOn: Boolean; { Text blink phase: True=visible, False=hidden }
|
||||
|
||||
{ Off-screen memory DC for ExtTextOut rendering }
|
||||
FMemDC: HDC; { Compatible memory DC for off-screen ExtTextOut }
|
||||
FMemBmp: HBitmap; { Compatible bitmap, one row tall, native format }
|
||||
FOldBmp: HBitmap; { Previous bitmap in FMemDC for cleanup }
|
||||
procedure AllocLine(Line: PTermLine);
|
||||
procedure ClearLine(Line: PTermLine);
|
||||
procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged;
|
||||
procedure CreateMemDC;
|
||||
procedure CreatePaintFont;
|
||||
procedure DeleteChars(N: Integer);
|
||||
procedure DeleteLines(N: Integer);
|
||||
procedure DestroyMemDC;
|
||||
procedure DirtyAll;
|
||||
procedure DirtyBlinkRows;
|
||||
procedure DirtyRow(Row: Integer);
|
||||
|
|
@ -134,7 +128,7 @@ type
|
|||
procedure ParseSGR;
|
||||
procedure ProcessChar(Ch: Char);
|
||||
procedure RecalcCellSize;
|
||||
procedure RenderRow(Row: Integer);
|
||||
procedure RenderRow(DC: HDC; Row: Integer);
|
||||
procedure ResizeScreen;
|
||||
procedure SetCols(Value: Integer);
|
||||
procedure SetCursorVisible(Value: Boolean);
|
||||
|
|
@ -380,10 +374,6 @@ begin
|
|||
FAllDirty := True;
|
||||
FScrollbarDirty := False;
|
||||
FTextBlinkOn := True;
|
||||
FMemDC := 0;
|
||||
FMemBmp := 0;
|
||||
FOldBmp := 0;
|
||||
|
||||
{ Set a monospace font -- OEM charset selected in CreatePaintFont }
|
||||
Font.Name := 'Terminal';
|
||||
Font.Size := 9;
|
||||
|
|
@ -399,28 +389,6 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.CreateMemDC;
|
||||
var
|
||||
ScrDC: HDC;
|
||||
begin
|
||||
DestroyMemDC;
|
||||
if (FCellWidth < 1) or (FCellHeight < 1) then
|
||||
Exit;
|
||||
ScrDC := GetDC(0);
|
||||
FMemDC := CreateCompatibleDC(ScrDC);
|
||||
FMemBmp := CreateCompatibleBitmap(ScrDC, FCols * FCellWidth, FCellHeight);
|
||||
ReleaseDC(0, ScrDC);
|
||||
if (FMemDC = 0) or (FMemBmp = 0) then
|
||||
begin
|
||||
DestroyMemDC;
|
||||
Exit;
|
||||
end;
|
||||
FOldBmp := SelectObject(FMemDC, FMemBmp);
|
||||
SelectObject(FMemDC, FPaintFont);
|
||||
SetBkMode(FMemDC, OPAQUE);
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.CreatePaintFont;
|
||||
var
|
||||
LF: TLogFont;
|
||||
|
|
@ -529,7 +497,6 @@ end;
|
|||
|
||||
destructor TKPAnsi.Destroy;
|
||||
begin
|
||||
DestroyMemDC;
|
||||
if (FPaintFont <> 0) and not FStockFont then
|
||||
begin
|
||||
DeleteObject(FPaintFont);
|
||||
|
|
@ -543,24 +510,6 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.DestroyMemDC;
|
||||
begin
|
||||
if FMemDC <> 0 then
|
||||
begin
|
||||
if FOldBmp <> 0 then
|
||||
SelectObject(FMemDC, FOldBmp);
|
||||
DeleteDC(FMemDC);
|
||||
FMemDC := 0;
|
||||
FOldBmp := 0;
|
||||
end;
|
||||
if FMemBmp <> 0 then
|
||||
begin
|
||||
DeleteObject(FMemBmp);
|
||||
FMemBmp := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.DirtyAll;
|
||||
begin
|
||||
FAllDirty := True;
|
||||
|
|
@ -569,7 +518,7 @@ end;
|
|||
|
||||
procedure TKPAnsi.DirtyBlinkRows;
|
||||
{ Targeted dirty marking for blink toggle. Instead of DirtyAll (which }
|
||||
{ forces a full 25-row re-render and 25 BitBlt calls), only dirty the }
|
||||
{ forces a full 25-row re-render), only dirty the }
|
||||
{ cursor row (cursor blink) and rows containing blink cells (text blink). }
|
||||
{ Typical BBS content has 0-3 blink rows, so this reduces blink overhead }
|
||||
{ from ~63ms to ~3ms on a 486. }
|
||||
|
|
@ -1096,11 +1045,11 @@ end;
|
|||
|
||||
|
||||
procedure TKPAnsi.FlipToScreen;
|
||||
{ Render dirty rows via ExtTextOut into the memory DC, then BitBlt each }
|
||||
{ to the screen (device format to device format = raw copy). Coalesced }
|
||||
{ ScrollDC shifts on-screen pixels to match FScreen after scrolling, }
|
||||
{ reducing the per-scroll GDI cost from 25 rows to just the newly exposed }
|
||||
{ rows. }
|
||||
{ Render dirty rows via ExtTextOut directly to the screen DC. CS_OWNDC }
|
||||
{ retains the selected font across GetDC calls, so no per-frame font }
|
||||
{ selection overhead. Coalesced ScrollDC shifts on-screen pixels to match }
|
||||
{ FScreen after scrolling, reducing the per-scroll cost from 25 rows to }
|
||||
{ just the newly exposed rows. }
|
||||
var
|
||||
DC: HDC;
|
||||
Row: Integer;
|
||||
|
|
@ -1112,9 +1061,9 @@ var
|
|||
begin
|
||||
if not HandleAllocated then
|
||||
Exit;
|
||||
if FMemDC = 0 then
|
||||
if FPaintFont = 0 then
|
||||
RecalcCellSize;
|
||||
if FMemDC = 0 then
|
||||
if FPaintFont = 0 then
|
||||
Exit;
|
||||
|
||||
{ Scrollback view: force full redraw (line mapping changes) }
|
||||
|
|
@ -1190,16 +1139,13 @@ begin
|
|||
Exit;
|
||||
end;
|
||||
|
||||
{ Interleaved render + blast: memory DC is reused per row }
|
||||
{ Render dirty rows directly to screen DC }
|
||||
DC := GetDC(Handle);
|
||||
for Row := 0 to FRows - 1 do
|
||||
begin
|
||||
if FAllDirty or FDirtyRow[Row] then
|
||||
begin
|
||||
RenderRow(Row);
|
||||
BitBlt(DC, 0, Row * FCellHeight,
|
||||
FCols * FCellWidth, FCellHeight,
|
||||
FMemDC, 0, 0, SRCCOPY);
|
||||
RenderRow(DC, Row);
|
||||
FDirtyRow[Row] := False;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -1364,22 +1310,21 @@ end;
|
|||
|
||||
procedure TKPAnsi.Paint;
|
||||
var
|
||||
DC: HDC;
|
||||
Row: Integer;
|
||||
begin
|
||||
if FMemDC = 0 then
|
||||
if FPaintFont = 0 then
|
||||
RecalcCellSize;
|
||||
if FMemDC = 0 then
|
||||
if FPaintFont = 0 then
|
||||
Exit;
|
||||
|
||||
{ Full repaint: render each row into the memory DC and blast it }
|
||||
{ Full repaint: render each row directly to screen }
|
||||
FAllDirty := True;
|
||||
DC := Canvas.Handle;
|
||||
|
||||
for Row := 0 to FRows - 1 do
|
||||
begin
|
||||
RenderRow(Row);
|
||||
BitBlt(Canvas.Handle, 0, Row * FCellHeight,
|
||||
FCols * FCellWidth, FCellHeight,
|
||||
FMemDC, 0, 0, SRCCOPY);
|
||||
RenderRow(DC, Row);
|
||||
FDirtyRow[Row] := False;
|
||||
end;
|
||||
FAllDirty := False;
|
||||
|
|
@ -1888,10 +1833,13 @@ begin
|
|||
{ Recreate the OEM charset paint font from current Font properties }
|
||||
CreatePaintFont;
|
||||
|
||||
{ Measure character cell size }
|
||||
{ Measure character cell size and configure the CS_OWNDC. The font and }
|
||||
{ background mode persist across GetDC/ReleaseDC with CS_OWNDC, so this }
|
||||
{ is effectively a one-time setup per font change. }
|
||||
DC := GetDC(Handle);
|
||||
try
|
||||
SelectObject(DC, FPaintFont);
|
||||
SetBkMode(DC, OPAQUE);
|
||||
Extent := GetTextExtent(DC, 'W', 1);
|
||||
FCellWidth := LoWord(Extent);
|
||||
FCellHeight := HiWord(Extent);
|
||||
|
|
@ -1908,20 +1856,17 @@ begin
|
|||
{ Resize control to fit terminal dimensions }
|
||||
Width := FCols * FCellWidth + GetSystemMetrics(sm_CxVScroll);
|
||||
Height := FRows * FCellHeight;
|
||||
|
||||
{ Create off-screen memory DC for ExtTextOut rendering }
|
||||
CreateMemDC;
|
||||
FAllDirty := True;
|
||||
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.RenderRow(Row: Integer);
|
||||
{ Render one terminal row into FMemDC using ExtTextOut with ETO_OPAQUE. }
|
||||
procedure TKPAnsi.RenderRow(DC: HDC; Row: Integer);
|
||||
{ Render one terminal row via ExtTextOut directly to the screen DC. }
|
||||
{ Scans cells for color runs (consecutive cells with same effective FG+BG) }
|
||||
{ and emits one ExtTextOut call per run. Typical BBS content = 2-5 runs }
|
||||
{ per row. Uniform color content (e.g. LORD II spaces) = 1 run per row. }
|
||||
{ and emits one ExtTextOut call per run. No intermediate bitmap -- the }
|
||||
{ display driver renders text directly into the framebuffer. }
|
||||
var
|
||||
Line: PTermLine;
|
||||
Col: Integer;
|
||||
|
|
@ -1937,9 +1882,9 @@ var
|
|||
RunBuf: array[0..255] of Char;
|
||||
RunLen: Integer;
|
||||
R: TRect;
|
||||
RowY: Integer;
|
||||
begin
|
||||
if FMemDC = 0 then
|
||||
Exit;
|
||||
RowY := Row * FCellHeight;
|
||||
|
||||
{ Determine which line to render (handles scrollback view) }
|
||||
if FScrollPos <> 0 then
|
||||
|
|
@ -1966,12 +1911,12 @@ begin
|
|||
if Line = nil then
|
||||
begin
|
||||
{ Blank row: fill with black background }
|
||||
SetBkColor(FMemDC, AnsiColors[0]);
|
||||
SetBkColor(DC, AnsiColors[0]);
|
||||
R.Left := 0;
|
||||
R.Top := 0;
|
||||
R.Top := RowY;
|
||||
R.Right := FCols * FCellWidth;
|
||||
R.Bottom := FCellHeight;
|
||||
ExtTextOut(FMemDC, 0, 0, ETO_OPAQUE, @R, nil, 0, nil);
|
||||
R.Bottom := RowY + FCellHeight;
|
||||
ExtTextOut(DC, 0, RowY, ETO_OPAQUE, @R, nil, 0, nil);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
|
|
@ -2009,13 +1954,13 @@ begin
|
|||
begin
|
||||
if RunLen > 0 then
|
||||
begin
|
||||
SetTextColor(FMemDC, AnsiColors[RunFG]);
|
||||
SetBkColor(FMemDC, AnsiColors[RunBG]);
|
||||
SetTextColor(DC, AnsiColors[RunFG]);
|
||||
SetBkColor(DC, AnsiColors[RunBG]);
|
||||
R.Left := RunStart * FCellWidth;
|
||||
R.Top := 0;
|
||||
R.Top := RowY;
|
||||
R.Right := (RunStart + RunLen) * FCellWidth;
|
||||
R.Bottom := FCellHeight;
|
||||
ExtTextOut(FMemDC, RunStart * FCellWidth, 0, ETO_OPAQUE, @R,
|
||||
R.Bottom := RowY + FCellHeight;
|
||||
ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
|
||||
@RunBuf[0], RunLen, nil);
|
||||
end;
|
||||
RunStart := Col;
|
||||
|
|
@ -2031,13 +1976,13 @@ begin
|
|||
{ Flush final run }
|
||||
if RunLen > 0 then
|
||||
begin
|
||||
SetTextColor(FMemDC, AnsiColors[RunFG]);
|
||||
SetBkColor(FMemDC, AnsiColors[RunBG]);
|
||||
SetTextColor(DC, AnsiColors[RunFG]);
|
||||
SetBkColor(DC, AnsiColors[RunBG]);
|
||||
R.Left := RunStart * FCellWidth;
|
||||
R.Top := 0;
|
||||
R.Top := RowY;
|
||||
R.Right := (RunStart + RunLen) * FCellWidth;
|
||||
R.Bottom := FCellHeight;
|
||||
ExtTextOut(FMemDC, RunStart * FCellWidth, 0, ETO_OPAQUE, @R,
|
||||
R.Bottom := RowY + FCellHeight;
|
||||
ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
|
||||
@RunBuf[0], RunLen, nil);
|
||||
end;
|
||||
end;
|
||||
|
|
@ -2180,7 +2125,7 @@ end;
|
|||
|
||||
procedure TKPAnsi.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
|
||||
begin
|
||||
{ Suppress background erase -- BitBlt covers everything }
|
||||
{ Suppress background erase -- ExtTextOut ETO_OPAQUE covers everything }
|
||||
Msg.Result := 1;
|
||||
end;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue