Optimize TKPAnsi rendering with batched TextOut and dirty row tracking

Separate parsing from rendering to eliminate per-character GDI calls.
ProcessChar now only updates cell data in memory; rendering is deferred
to FlipToScreen which batches consecutive same-color cells into single
TextOut calls (~5-10 per row instead of 80). Partial BitBlt transfers
only the dirty row band to the screen. Non-blinking rows render to one
buffer and BitBlt to the second, halving GDI work for typical content.

Also removes redundant GetCommError from KPComm receive path and adds
BeginUpdate/EndUpdate batching in the test app's CommEvent handler.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

delphi/KPANSI.PAS

@@ -61,37 +61,47 @@ type
     FOnKeyData:      TKeyDataEvent;
     FPaintFont:      HFont;
     FStockFont:      Boolean;
-    FMemDC:          HDC;
+    FBlinkPhase:     Integer;
-    FMemBmp:         HBitmap;
+    FUpdateCount:    Integer;
-    FMemOldBmp:      HBitmap;
+    FDirtyRow:       array[0..255] of Boolean;
+    FAllDirty:       Boolean;
+    FBufDC:          array[0..1] of HDC;
+    FBufBmp:         array[0..1] of HBitmap;
+    FBufOldBmp:      array[0..1] of HBitmap;
     FBufW:           Integer;
     FBufH:           Integer;
-    FTextBlinkOn:    Boolean;
-    FBlinkCount:     Integer;
     procedure AllocLine(Line: PTermLine);
+    procedure ClearBufRect(X, Y, W, H: Integer; BG: TColor);
     procedure ClearLine(Line: PTermLine);
     procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged;
-    procedure CreateBackBuffer;
+    procedure CreateBuffers;
     procedure CreatePaintFont;
     procedure DeleteChars(N: Integer);
     procedure DeleteLines(N: Integer);
-    procedure DestroyBackBuffer;
+    procedure DestroyBuffers;
+    procedure DirtyAll;
+    procedure DirtyRow(Row: Integer);
     procedure DoScrollDown;
     procedure DoScrollUp;
+    procedure DrawRow(Row: Integer);
     procedure EraseDisplay(Mode: Integer);
     procedure EraseLine(Mode: Integer);
     procedure ExecuteCSI(FinalCh: Char);
     procedure ExecuteMusic;
+    procedure FlipToScreen;
     procedure FreeLineList(List: TList);
     function  GetCursorCol: Integer;
     function  GetCursorRow: Integer;
     procedure InsertChars(N: Integer);
     procedure InsertLines(N: Integer);
+    procedure PaintLine(Line: PTermLine; PixelY: Integer);
     procedure ParseData(const S: string);
     procedure ParseSGR;
     procedure ProcessChar(Ch: Char);
     procedure RecalcCellSize;
+    procedure RedrawBuffers;
     procedure ResizeScreen;
+    procedure ScrollBufs(N: Integer);
     procedure SetCols(Value: Integer);
     procedure SetCursorVisible(Value: Boolean);
     procedure SetRows(Value: Integer);
@@ -110,7 +120,9 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    procedure BeginUpdate;
     procedure Clear;
+    procedure EndUpdate;
     procedure Reset;
     procedure Write(const S: string);
     property CursorCol: Integer read GetCursorCol;
@@ -227,6 +239,12 @@ begin
 end;
 
 
+procedure TKPAnsi.BeginUpdate;
+begin
+  Inc(FUpdateCount);
+end;
+
+
 procedure TKPAnsi.Clear;
 var
   I:    Integer;
@@ -253,6 +271,7 @@ begin
   FCursorCol := 0;
   FScrollPos := 0;
   UpdateScrollbar;
+  FAllDirty := True;
   Invalidate;
 end;
 
@@ -315,13 +334,15 @@ begin
   FWrapMode        := True;
   FPaintFont       := 0;
   FStockFont       := False;
-  FMemDC           := 0;
+  FBlinkPhase      := 0;
-  FMemBmp          := 0;
+  FUpdateCount     := 0;
-  FMemOldBmp       := 0;
+  FAllDirty        := True;
+  FBufDC[0]        := 0;
+  FBufDC[1]        := 0;
+  FBufBmp[0]       := 0;
+  FBufBmp[1]       := 0;
   FBufW            := 0;
   FBufH            := 0;
-  FTextBlinkOn     := True;
-  FBlinkCount      := 0;
 
   { Set a monospace font -- OEM charset selected in CreatePaintFont }
   Font.Name  := 'Terminal';
@@ -338,31 +359,6 @@ begin
 end;
 
 
-procedure TKPAnsi.CreateBackBuffer;
-var
-  ScreenDC: HDC;
-begin
-  DestroyBackBuffer;
-  FBufW := FCols * FCellWidth;
-  FBufH := FRows * FCellHeight;
-  if (FBufW < 1) or (FBufH < 1) then
-    Exit;
-
-  { Create a memory DC with compatible bitmap for double buffering. }
-  { We manage this DC directly with GDI calls -- no TCanvas/TBitmap }
-  { involvement -- so our OEM_CHARSET font stays selected and       }
-  { cannot be overridden by VCL font realization.                   }
-  ScreenDC := GetDC(0);
-  FMemDC     := CreateCompatibleDC(ScreenDC);
-  FMemBmp    := CreateCompatibleBitmap(ScreenDC, FBufW, FBufH);
-  ReleaseDC(0, ScreenDC);
-  FMemOldBmp := SelectObject(FMemDC, FMemBmp);
-  if FPaintFont <> 0 then
-    SelectObject(FMemDC, FPaintFont);
-  SetBkMode(FMemDC, OPAQUE);
-end;
-
-
 procedure TKPAnsi.CreatePaintFont;
 var
   LF:       TLogFont;
@@ -376,7 +372,9 @@ begin
   FStockFont := False;
 
   { Build LOGFONT requesting OEM_CHARSET with raster precision for CP437 }
-  { box-drawing, block elements, and other BBS ANSI art glyphs.          }
+  { box-drawing, block elements, and other BBS ANSI art glyphs.  Raster }
+  { precision prevents the font mapper from substituting a TrueType font }
+  { that might remap character codes through Unicode tables.              }
   FillChar(LF, SizeOf(LF), 0);
   LF.lfHeight         := Font.Height;
   LF.lfPitchAndFamily := FIXED_PITCH or FF_MODERN;
@@ -394,21 +392,25 @@ begin
     { Verify Windows actually gave us an OEM charset font }
     GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
     if ActualLF.lfCharSet = OEM_CHARSET then
-    begin
+      FPaintFont := NewFont
-      FPaintFont := NewFont;
+    else
-      if FMemDC <> 0 then
-        SelectObject(FMemDC, FPaintFont);
-      Exit;
-    end;
-    { Windows substituted a non-OEM font; discard it }
       DeleteObject(NewFont);
   end;
 
-  { Fall back to the stock OEM fixed font -- guaranteed CP437 }
+  if FPaintFont = 0 then
+  begin
     FPaintFont := GetStockObject(OEM_FIXED_FONT);
     FStockFont := True;
-  if FMemDC <> 0 then
+  end;
-    SelectObject(FMemDC, FPaintFont);
+
+  { Select font into both buffer DCs }
+  if FPaintFont <> 0 then
+  begin
+    if FBufDC[0] <> 0 then
+      SelectObject(FBufDC[0], FPaintFont);
+    if FBufDC[1] <> 0 then
+      SelectObject(FBufDC[1], FPaintFont);
+  end;
 end;
 
 
@@ -416,6 +418,364 @@ procedure TKPAnsi.CreateParams(var Params: TCreateParams);
 begin
   inherited CreateParams(Params);
   Params.Style := Params.Style or ws_VScroll;
+  { CS_OWNDC gives us a private DC whose state (selected font, BkMode,  }
+  { colors) persists across GetDC/ReleaseDC calls.  This eliminates the }
+  { per-frame cost of SelectObject + SetBkMode that otherwise dominates  }
+  { rendering time on Win16.                                             }
+  Params.WindowClass.Style := Params.WindowClass.Style or cs_OwnDC;
+end;
+
+
+procedure TKPAnsi.ClearBufRect(X, Y, W, H: Integer; BG: TColor);
+var
+  R:   TRect;
+  HBr: HBrush;
+  I:   Integer;
+begin
+  R.Left   := X;
+  R.Top    := Y;
+  R.Right  := X + W;
+  R.Bottom := Y + H;
+  HBr := CreateSolidBrush(ColorToRGB(BG));
+  for I := 0 to 1 do
+  begin
+    if FBufDC[I] <> 0 then
+      FillRect(FBufDC[I], R, HBr);
+  end;
+  DeleteObject(HBr);
+end;
+
+
+procedure TKPAnsi.CreateBuffers;
+var
+  ScreenDC: HDC;
+  I:        Integer;
+begin
+  DestroyBuffers;
+  FBufW := FCols * FCellWidth;
+  FBufH := FRows * FCellHeight;
+  if (FBufW < 1) or (FBufH < 1) then
+    Exit;
+  ScreenDC := GetDC(0);
+  for I := 0 to 1 do
+  begin
+    FBufDC[I]     := CreateCompatibleDC(ScreenDC);
+    FBufBmp[I]    := CreateCompatibleBitmap(ScreenDC, FBufW, FBufH);
+    FBufOldBmp[I] := SelectObject(FBufDC[I], FBufBmp[I]);
+    if FPaintFont <> 0 then
+      SelectObject(FBufDC[I], FPaintFont);
+    SetBkMode(FBufDC[I], OPAQUE);
+  end;
+  ReleaseDC(0, ScreenDC);
+end;
+
+
+procedure TKPAnsi.DestroyBuffers;
+var
+  I: Integer;
+begin
+  for I := 0 to 1 do
+  begin
+    if FBufDC[I] <> 0 then
+    begin
+      SelectObject(FBufDC[I], FBufOldBmp[I]);
+      DeleteObject(FBufBmp[I]);
+      DeleteDC(FBufDC[I]);
+      FBufDC[I]     := 0;
+      FBufBmp[I]    := 0;
+      FBufOldBmp[I] := 0;
+    end;
+  end;
+end;
+
+
+procedure TKPAnsi.DirtyAll;
+begin
+  FAllDirty := True;
+end;
+
+
+procedure TKPAnsi.DirtyRow(Row: Integer);
+begin
+  if (Row >= 0) and (Row <= 255) then
+    FDirtyRow[Row] := True;
+end;
+
+
+procedure TKPAnsi.DrawRow(Row: Integer);
+begin
+  if (Row >= 0) and (Row < FScreen.Count) then
+    PaintLine(FScreen[Row], Row * FCellHeight);
+end;
+
+
+procedure TKPAnsi.PaintLine(Line: PTermLine; PixelY: Integer);
+{ Render a line to both buffer DCs using batched TextOut.          }
+{ Groups consecutive cells with identical colors into single calls }
+{ (typically 5-10 per row instead of 80 per-cell calls).           }
+var
+  Col:        Integer;
+  BatchStart: Integer;
+  BatchLen:   Integer;
+  I:          Integer;
+  X:          Integer;
+  CellFG:     TColor;
+  CellBG:     TColor;
+  CurFG:      TColor;
+  CurBG:      TColor;
+  HasBlink:   Boolean;
+  Buf:        array[0..255] of Char;
+begin
+  if FBufDC[0] = 0 then
+    Exit;
+
+  { Check if any cell on this line blinks }
+  HasBlink := False;
+  for Col := 0 to FCols - 1 do
+  begin
+    if Line^.Cells[Col].Blink then
+    begin
+      HasBlink := True;
+      Break;
+    end;
+  end;
+
+  if HasBlink then
+  begin
+    { Blink row: must render to each buffer separately }
+    for I := 0 to 1 do
+    begin
+      if FBufDC[I] = 0 then
+        Continue;
+      CurFG      := TColor(-1);
+      CurBG      := TColor(-1);
+      BatchStart := 0;
+      BatchLen   := 0;
+
+      for Col := 0 to FCols - 1 do
+      begin
+        CellBG := Line^.Cells[Col].BG;
+        if (I = 1) and Line^.Cells[Col].Blink then
+          CellFG := CellBG
+        else
+          CellFG := Line^.Cells[Col].FG;
+
+        if (CellFG <> CurFG) or (CellBG <> CurBG) then
+        begin
+          if BatchLen > 0 then
+          begin
+            X := BatchStart * FCellWidth;
+            WinProcs.TextOut(FBufDC[I], X, PixelY, @Buf[0], BatchLen);
+          end;
+          if CellFG <> CurFG then
+          begin
+            SetTextColor(FBufDC[I], ColorToRGB(CellFG));
+            CurFG := CellFG;
+          end;
+          if CellBG <> CurBG then
+          begin
+            SetBkColor(FBufDC[I], ColorToRGB(CellBG));
+            CurBG := CellBG;
+          end;
+          BatchStart := Col;
+          BatchLen   := 0;
+        end;
+
+        Buf[BatchLen] := Line^.Cells[Col].Ch;
+        Inc(BatchLen);
+      end;
+
+      if BatchLen > 0 then
+      begin
+        X := BatchStart * FCellWidth;
+        WinProcs.TextOut(FBufDC[I], X, PixelY, @Buf[0], BatchLen);
+      end;
+    end;
+  end
+  else
+  begin
+    { No blink: render to buffer 0 only, then copy row to buffer 1 }
+    CurFG      := TColor(-1);
+    CurBG      := TColor(-1);
+    BatchStart := 0;
+    BatchLen   := 0;
+
+    for Col := 0 to FCols - 1 do
+    begin
+      CellFG := Line^.Cells[Col].FG;
+      CellBG := Line^.Cells[Col].BG;
+
+      if (CellFG <> CurFG) or (CellBG <> CurBG) then
+      begin
+        if BatchLen > 0 then
+        begin
+          X := BatchStart * FCellWidth;
+          WinProcs.TextOut(FBufDC[0], X, PixelY, @Buf[0], BatchLen);
+        end;
+        if CellFG <> CurFG then
+        begin
+          SetTextColor(FBufDC[0], ColorToRGB(CellFG));
+          CurFG := CellFG;
+        end;
+        if CellBG <> CurBG then
+        begin
+          SetBkColor(FBufDC[0], ColorToRGB(CellBG));
+          CurBG := CellBG;
+        end;
+        BatchStart := Col;
+        BatchLen   := 0;
+      end;
+
+      Buf[BatchLen] := Line^.Cells[Col].Ch;
+      Inc(BatchLen);
+    end;
+
+    if BatchLen > 0 then
+    begin
+      X := BatchStart * FCellWidth;
+      WinProcs.TextOut(FBufDC[0], X, PixelY, @Buf[0], BatchLen);
+    end;
+
+    { Copy rendered row from buffer 0 to buffer 1 }
+    if FBufDC[1] <> 0 then
+      BitBlt(FBufDC[1], 0, PixelY, FBufW, FCellHeight,
+        FBufDC[0], 0, PixelY, SRCCOPY);
+  end;
+end;
+
+
+procedure TKPAnsi.FlipToScreen;
+var
+  DC:       HDC;
+  Row:      Integer;
+  MinDirty: Integer;
+  MaxDirty: Integer;
+  FullBlt:  Boolean;
+  Line:     PTermLine;
+  X:        Integer;
+  Y:        Integer;
+  SrcY:     Integer;
+  H:        Integer;
+begin
+  if not HandleAllocated then
+    Exit;
+  if FBufDC[0] = 0 then
+    RecalcCellSize;
+  if FBufDC[0] = 0 then
+    Exit;
+
+  FullBlt := FAllDirty;
+
+  if FScrollPos <> 0 then
+  begin
+    { Scrollback view: full redraw from scrollback + screen data }
+    RedrawBuffers;
+    FullBlt := True;
+  end
+  else
+  begin
+    { Render only dirty rows into both buffers (batched TextOut) }
+    MinDirty := FRows;
+    MaxDirty := -1;
+    for Row := 0 to FRows - 1 do
+    begin
+      if FAllDirty or FDirtyRow[Row] then
+      begin
+        if Row < FScreen.Count then
+          PaintLine(FScreen[Row], Row * FCellHeight);
+        FDirtyRow[Row] := False;
+        if Row < MinDirty then
+          MinDirty := Row;
+        if Row > MaxDirty then
+          MaxDirty := Row;
+      end;
+    end;
+    FAllDirty := False;
+  end;
+
+  DC := GetDC(Handle);
+
+  if FullBlt then
+  begin
+    { Full screen BitBlt (scrollback, resize, blink all-dirty) }
+    BitBlt(DC, 0, 0, FBufW, FBufH,
+      FBufDC[FBlinkPhase], 0, 0, SRCCOPY);
+  end
+  else if MaxDirty >= 0 then
+  begin
+    { Partial BitBlt: only the dirty row band }
+    SrcY := MinDirty * FCellHeight;
+    H    := (MaxDirty - MinDirty + 1) * FCellHeight;
+    BitBlt(DC, 0, SrcY, FBufW, H,
+      FBufDC[FBlinkPhase], 0, SrcY, SRCCOPY);
+  end;
+
+  { Cursor overlay -- drawn directly to screen, not in buffers }
+  if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
+     (FCursorRow >= 0) and (FCursorRow < FRows) and
+     (FCursorRow < FScreen.Count) and
+     (FCursorCol >= 0) and (FCursorCol < FCols) then
+  begin
+    Line := FScreen[FCursorRow];
+    X := FCursorCol * FCellWidth;
+    Y := FCursorRow * FCellHeight;
+    SetTextColor(DC, ColorToRGB(Line^.Cells[FCursorCol].BG));
+    SetBkColor(DC, ColorToRGB(Line^.Cells[FCursorCol].FG));
+    WinProcs.TextOut(DC, X, Y, @Line^.Cells[FCursorCol].Ch, 1);
+  end;
+
+  ReleaseDC(Handle, DC);
+end;
+
+
+procedure TKPAnsi.RedrawBuffers;
+var
+  Row:      Integer;
+  VisRow:   Integer;
+  SbkCount: Integer;
+  Line:     PTermLine;
+begin
+  if FBufDC[0] = 0 then
+    Exit;
+  SbkCount := FScrollback.Count;
+  for Row := 0 to FRows - 1 do
+  begin
+    VisRow := Row - FScrollPos;
+    if VisRow < 0 then
+    begin
+      if (SbkCount + VisRow >= 0) and (SbkCount + VisRow < SbkCount) then
+        Line := FScrollback[SbkCount + VisRow]
+      else
+        Line := nil;
+    end
+    else if VisRow < FScreen.Count then
+      Line := FScreen[VisRow]
+    else
+      Line := nil;
+
+    if Line = nil then
+      ClearBufRect(0, Row * FCellHeight, FBufW, FCellHeight, AnsiColors[0])
+    else
+      PaintLine(Line, Row * FCellHeight);
+  end;
+end;
+
+
+procedure TKPAnsi.ScrollBufs(N: Integer);
+var
+  R:       TRect;
+  I:       Integer;
+  ScrollY: Integer;
+begin
+  if FBufDC[0] = 0 then
+    Exit;
+  ScrollY := N * FCellHeight;
+  R.Left   := 0;
+  R.Top    := 0;
+  R.Right  := FBufW;
+  R.Bottom := FBufH;
+  for I := 0 to 1 do
+    ScrollDC(FBufDC[I], 0, -ScrollY, R, R, 0, nil);
 end;
 
 
@@ -427,12 +787,8 @@ begin
   if N < 1 then
     N := 1;
   Line := FScreen[FCursorRow];
-  { Shift cells left }
   for I := FCursorCol to FCols - 1 - N do
-  begin
     Line^.Cells[I] := Line^.Cells[I + N];
-  end;
-  { Clear vacated cells at end }
   for I := FCols - N to FCols - 1 do
   begin
     if I >= 0 then
@@ -444,12 +800,14 @@ begin
       Line^.Cells[I].Blink := False;
     end;
   end;
+  FDirtyRow[FCursorRow] := True;
 end;
 
 
 procedure TKPAnsi.DeleteLines(N: Integer);
 var
   I:    Integer;
+  J:    Integer;
   Line: PTermLine;
 begin
   if N < 1 then
@@ -461,37 +819,24 @@ begin
       Line := FScreen[FCursorRow];
       FreeMem(Line, SizeOf(TTermLineRec));
       FScreen.Delete(FCursorRow);
-      { Add a blank line at the bottom }
       GetMem(Line, SizeOf(TTermLineRec));
       AllocLine(Line);
       FScreen.Add(Line);
     end;
   end;
-end;
+  for J := FCursorRow to FRows - 1 do
-
+    FDirtyRow[J] := True;
-
-procedure TKPAnsi.DestroyBackBuffer;
-begin
-  if FMemDC <> 0 then
-  begin
-    SelectObject(FMemDC, FMemOldBmp);
-    DeleteObject(FMemBmp);
-    DeleteDC(FMemDC);
-    FMemDC     := 0;
-    FMemBmp    := 0;
-    FMemOldBmp := 0;
-  end;
 end;
 
 
 destructor TKPAnsi.Destroy;
 begin
-  if FTimerActive then
+  if FTimerActive and HandleAllocated then
   begin
     KillTimer(Handle, 1);
     FTimerActive := False;
   end;
-  DestroyBackBuffer;
+  DestroyBuffers;
   if (FPaintFont <> 0) and not FStockFont then
   begin
     DeleteObject(FPaintFont);
@@ -519,6 +864,8 @@ begin
   GetMem(Line, SizeOf(TTermLineRec));
   AllocLine(Line);
   FScreen.Insert(0, Line);
+  ScrollBufs(-1);
+  FDirtyRow[0] := True;
 end;
 
 
@@ -538,6 +885,19 @@ begin
   AllocLine(Line);
   FScreen.Add(Line);
   UpdateScrollbar;
+  ScrollBufs(1);
+  FDirtyRow[FRows - 1] := True;
+end;
+
+
+procedure TKPAnsi.EndUpdate;
+begin
+  Dec(FUpdateCount);
+  if FUpdateCount <= 0 then
+  begin
+    FUpdateCount := 0;
+    FlipToScreen;
+  end;
 end;
 
 
@@ -601,6 +961,17 @@ begin
         UpdateScrollbar;
       end;
   end;
+  { Mark affected rows dirty for deferred batch rendering }
+  case Mode of
+    0:
+      for I := FCursorRow to FRows - 1 do
+        FDirtyRow[I] := True;
+    1:
+      for I := 0 to FCursorRow do
+        FDirtyRow[I] := True;
+    2:
+      FAllDirty := True;
+  end;
 end;
 
 
@@ -634,10 +1005,9 @@ begin
         end;
       end;
     2: { Erase entire line }
-      begin
       ClearLine(Line);
   end;
-  end;
+  FDirtyRow[FCursorRow] := True;
 end;
 
 
@@ -1008,12 +1378,8 @@ begin
   if N < 1 then
     N := 1;
   Line := FScreen[FCursorRow];
-  { Shift cells right }
   for I := FCols - 1 downto FCursorCol + N do
-  begin
     Line^.Cells[I] := Line^.Cells[I - N];
-  end;
-  { Clear inserted cells }
   for I := FCursorCol to FCursorCol + N - 1 do
   begin
     if I < FCols then
@@ -1025,30 +1391,32 @@ begin
       Line^.Cells[I].Blink := False;
     end;
   end;
+  FDirtyRow[FCursorRow] := True;
 end;
 
 
 procedure TKPAnsi.InsertLines(N: Integer);
 var
   I:    Integer;
+  J:    Integer;
   Line: PTermLine;
 begin
   if N < 1 then
     N := 1;
   for I := 1 to N do
   begin
-    { Remove bottom line }
     if FScreen.Count > 0 then
     begin
       Line := FScreen[FScreen.Count - 1];
       FreeMem(Line, SizeOf(TTermLineRec));
       FScreen.Delete(FScreen.Count - 1);
     end;
-    { Insert blank line at cursor row }
     GetMem(Line, SizeOf(TTermLineRec));
     AllocLine(Line);
     FScreen.Insert(FCursorRow, Line);
   end;
+  for J := FCursorRow to FRows - 1 do
+    FDirtyRow[J] := True;
 end;
 
 
@@ -1135,123 +1503,41 @@ end;
 procedure TKPAnsi.Paint;
 var
   Row:  Integer;
-  Col:       Integer;
+  Line: PTermLine;
   X:    Integer;
   Y:    Integer;
-  Line:      PTermLine;
-  StartCol:  Integer;
-  BatchBuf:  array[0..255] of Char;
-  BatchLen:  Integer;
-  BatchFG:   TColor;
-  BatchBG:   TColor;
-  CellFG:    TColor;
-  VisRow:    Integer;
-  SbkOffset: Integer;
-  SbkCount:  Integer;
-  R:         TRect;
-  HBr:       HBrush;
 begin
-  { Ensure back buffer exists (created by RecalcCellSize) }
+  if FBufDC[0] = 0 then
-  if FMemDC = 0 then
     RecalcCellSize;
-  if FMemDC = 0 then
+  if FBufDC[0] = 0 then
     Exit;
 
-  { Pre-fill entire back buffer with black so no white pixels can }
+  { Ensure all rows are rendered into buffers }
-  { leak through gaps between rows or at the edges.               }
-  R.Left   := 0;
-  R.Top    := 0;
-  R.Right  := FBufW;
-  R.Bottom := FBufH;
-  HBr := CreateSolidBrush(ColorToRGB(AnsiColors[0]));
-  FillRect(FMemDC, R, HBr);
-  DeleteObject(HBr);
-
-  SbkCount := FScrollback.Count;
-
   for Row := 0 to FRows - 1 do
   begin
-    Y := Row * FCellHeight;
+    if Row < FScreen.Count then
-
+      PaintLine(FScreen[Row], Row * FCellHeight);
-    { Determine which line to display based on scroll position }
+    FDirtyRow[Row] := False;
-    VisRow := Row - FScrollPos;
-    if VisRow < 0 then
-    begin
-      { Drawing from scrollback }
-      SbkOffset := SbkCount + VisRow;
-      if (SbkOffset >= 0) and (SbkOffset < SbkCount) then
-        Line := FScrollback[SbkOffset]
-      else
-        Line := nil;
-    end
-    else
-    begin
-      { Drawing from active screen }
-      if VisRow < FScreen.Count then
-        Line := FScreen[VisRow]
-      else
-        Line := nil;
   end;
+  FAllDirty := False;
 
-    if Line = nil then
+  { BitBlt to canvas (provided by VCL WM_PAINT handler) }
-      Continue;
-
-    { Batch consecutive cells with same effective colors into a single }
-    { TextOut call for performance.  Uses a fixed char array instead   }
-    { of string concatenation to avoid heap allocation per cell.       }
-    { When text blink is in the off phase, blinking cells render with  }
-    { FG = BG so the text becomes invisible.                           }
-    Col := 0;
-    while Col < FCols do
-    begin
-      StartCol := Col;
-      BatchBG  := Line^.Cells[Col].BG;
-      if Line^.Cells[Col].Blink and not FTextBlinkOn then
-        BatchFG := BatchBG
-      else
-        BatchFG := Line^.Cells[Col].FG;
-      BatchBuf[0] := Line^.Cells[Col].Ch;
-      BatchLen    := 1;
-      Inc(Col);
-
-      { Extend batch while effective colors match }
-      while Col < FCols do
-      begin
-        if Line^.Cells[Col].BG <> BatchBG then
-          Break;
-        if Line^.Cells[Col].Blink and not FTextBlinkOn then
-          CellFG := BatchBG
-        else
-          CellFG := Line^.Cells[Col].FG;
-        if CellFG <> BatchFG then
-          Break;
-        BatchBuf[BatchLen] := Line^.Cells[Col].Ch;
-        Inc(BatchLen);
-        Inc(Col);
-      end;
-
-      X := StartCol * FCellWidth;
-      SetTextColor(FMemDC, ColorToRGB(BatchFG));
-      SetBkColor(FMemDC, ColorToRGB(BatchBG));
-      WinProcs.TextOut(FMemDC, X, Y, @BatchBuf[0], BatchLen);
-    end;
-
-    { Draw cursor if on this row and visible }
-    if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
-       (Row = FCursorRow) and (FCursorCol < FCols) then
-    begin
-      X := FCursorCol * FCellWidth;
-      { Invert the cursor cell }
-      SetTextColor(FMemDC, ColorToRGB(Line^.Cells[FCursorCol].BG));
-      SetBkColor(FMemDC, ColorToRGB(Line^.Cells[FCursorCol].FG));
-      WinProcs.TextOut(FMemDC, X, Y,
-        @Line^.Cells[FCursorCol].Ch, 1);
-    end;
-  end;
-
-  { Blit the completed frame to screen in one operation }
   BitBlt(Canvas.Handle, 0, 0, FBufW, FBufH,
-    FMemDC, 0, 0, SRCCOPY);
+    FBufDC[FBlinkPhase], 0, 0, SRCCOPY);
+
+  { Cursor overlay }
+  if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
+     (FCursorRow >= 0) and (FCursorRow < FRows) and
+     (FCursorRow < FScreen.Count) and
+     (FCursorCol >= 0) and (FCursorCol < FCols) then
+  begin
+    Line := FScreen[FCursorRow];
+    X := FCursorCol * FCellWidth;
+    Y := FCursorRow * FCellHeight;
+    SetTextColor(Canvas.Handle, ColorToRGB(Line^.Cells[FCursorCol].BG));
+    SetBkColor(Canvas.Handle, ColorToRGB(Line^.Cells[FCursorCol].FG));
+    WinProcs.TextOut(Canvas.Handle, X, Y, @Line^.Cells[FCursorCol].Ch, 1);
+  end;
 end;
 
 
@@ -1260,27 +1546,21 @@ var
   I: Integer;
 begin
   for I := 1 to Length(S) do
-  begin
     ProcessChar(S[I]);
-  end;
 
   { Snap to bottom on new data }
   if FScrollPos <> 0 then
   begin
     FScrollPos := 0;
     UpdateScrollbar;
+    FAllDirty := True;
   end;
 
   { Reset cursor blink to visible on new data }
   FBlinkOn := True;
 
-  { Invalidate + Update forces an immediate synchronous repaint.     }
+  if FUpdateCount = 0 then
-  { Without Update, WM_PAINT is low-priority and gets starved by     }
+    FlipToScreen;
-  { incoming WM_COMMNOTIFY messages, causing visible input lag.      }
-  { The paint loop uses a fixed char array (no heap allocs) and our  }
-  { own GDI memory DC, so repainting is fast enough for this.        }
-  Invalidate;
-  Update;
 end;
 
 
@@ -1426,6 +1706,9 @@ begin
               Line^.Cells[FCursorCol].Bold  := FAttrBold;
               Line^.Cells[FCursorCol].Blink := FAttrBlink;
 
+              { Mark row dirty for deferred batch rendering }
+              FDirtyRow[FCursorRow] := True;
+
               Inc(FCursorCol);
             end;
         end;
@@ -1536,10 +1819,6 @@ begin
   if not HandleAllocated then
     Exit;
 
-  { Destroy back buffer first so the old font is not selected in any }
-  { DC when CreatePaintFont deletes it.                               }
-  DestroyBackBuffer;
-
   { Recreate the OEM charset paint font from current Font properties }
   CreatePaintFont;
 
@@ -1565,8 +1844,9 @@ begin
   Width  := FCols * FCellWidth + GetSystemMetrics(sm_CxVScroll);
   Height := FRows * FCellHeight;
 
-  { (Re)create the GDI back buffer at the new size }
+  { (Re)create dual bitmaps; mark all rows dirty for next render }
-  CreateBackBuffer;
+  CreateBuffers;
+  FAllDirty := True;
 
   { Start cursor blink timer }
   if not FTimerActive then
@@ -1639,7 +1919,9 @@ begin
   if Value <> FCursorVisible then
   begin
     FCursorVisible := Value;
-    Invalidate;
+    { Mark cursor row dirty so BitBlt erases/redraws cursor overlay }
+    FDirtyRow[FCursorRow] := True;
+    FlipToScreen;
   end;
 end;
 
@@ -1702,7 +1984,7 @@ end;
 
 procedure TKPAnsi.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
 begin
-  { Suppress background erase -- double-buffered Paint covers everything }
+  { Suppress background erase -- TextOut with OPAQUE covers everything }
   Msg.Result := 1;
 end;
 
@@ -1714,20 +1996,44 @@ end;
 
 
 procedure TKPAnsi.WMTimer(var Msg: TWMTimer);
+var
+  DC:   HDC;
+  Line: PTermLine;
+  X:    Integer;
+  Y:    Integer;
 begin
   FBlinkOn := not FBlinkOn;
 
-  { Text blink runs at half the cursor rate (every other tick) so }
+  { Toggle text blink phase by swapping which buffer is displayed. }
-  { blinking text toggles roughly once per second.                 }
+  { Buffers are already up-to-date; just BitBlt the other one.     }
-  Inc(FBlinkCount);
+  Inc(FBlinkPhase);
-  if FBlinkCount >= 2 then
+  if FBlinkPhase > 1 then
+    FBlinkPhase := 0;
+
+  if not HandleAllocated then
+    Exit;
+  if FBufDC[0] = 0 then
+    Exit;
+
+  DC := GetDC(Handle);
+  BitBlt(DC, 0, 0, FBufW, FBufH,
+    FBufDC[FBlinkPhase], 0, 0, SRCCOPY);
+
+  { Cursor overlay }
+  if FCursorVisible and FBlinkOn and (FScrollPos = 0) and
+     (FCursorRow >= 0) and (FCursorRow < FRows) and
+     (FCursorRow < FScreen.Count) and
+     (FCursorCol >= 0) and (FCursorCol < FCols) then
   begin
-    FBlinkCount  := 0;
+    Line := FScreen[FCursorRow];
-    FTextBlinkOn := not FTextBlinkOn;
+    X := FCursorCol * FCellWidth;
+    Y := FCursorRow * FCellHeight;
+    SetTextColor(DC, ColorToRGB(Line^.Cells[FCursorCol].BG));
+    SetBkColor(DC, ColorToRGB(Line^.Cells[FCursorCol].FG));
+    WinProcs.TextOut(DC, X, Y, @Line^.Cells[FCursorCol].Ch, 1);
   end;
 
-  { Always repaint: cursor blink and text blink both need it }
+  ReleaseDC(Handle, DC);
-  Invalidate;
 end;
 
 
@@ -1767,7 +2073,7 @@ begin
   begin
     FScrollPos := NewPos;
     SetScrollPos(Handle, sb_Vert, SbkCount - FScrollPos, True);
-    Invalidate;
+    FlipToScreen;
   end;
 end;
 

delphi/KPCOMM.PAS

@@ -351,7 +351,6 @@ end;
 
 function TKPComm.GetInput: string;
 var
-  Stat:        TComStat;
   BytesToRead: Integer;
   BytesRead:   Integer;
   Buf:         array[0..255] of Char;
@@ -360,15 +359,12 @@ begin
   if not FPortOpen or (FCommId < 0) then
     Exit;
 
-  GetCommError(FCommId, Stat);
+  { Read directly without querying GetCommError first.  ReadComm      }
-  BytesToRead := Stat.cbInQue;
+  { returns the number of bytes actually available (up to BytesToRead) }
-
+  { so the extra GetCommError round-trip is unnecessary overhead.      }
+  BytesToRead := 255;
   if (FInputLen > 0) and (BytesToRead > FInputLen) then
     BytesToRead := FInputLen;
-  if BytesToRead > 255 then
-    BytesToRead := 255;
-  if BytesToRead <= 0 then
-    Exit;
 
   BytesRead := ReadComm(FCommId, @Buf, BytesToRead);
   if BytesRead <= 0 then
@@ -558,13 +554,11 @@ end;
 
 
 procedure TKPComm.ProcessReceiveNotify;
-var
-  Stat: TComStat;
 begin
   if FRThreshold <= 0 then
     Exit;
-  GetCommError(FCommId, Stat);
+  { WM_COMMNOTIFY with CN_RECEIVE means data is available -- the driver }
-  if Integer(Stat.cbInQue) >= FRThreshold then
+  { already checked the threshold.  No need to call GetCommError here.  }
   DoCommEvent(comEvReceive);
 end;
 

delphi/TESTMAIN.PAS

@@ -85,9 +85,19 @@ begin
   case FComm.CommEvent of
     comEvReceive:
       begin
+        { Drain all available data in a single update batch.  This    }
+        { suppresses per-Write rendering so we get one paint at the   }
+        { end instead of one per 255-byte chunk.                      }
+        FAnsi.BeginUpdate;
+        try
+          repeat
             S := FComm.Input;
             if Length(S) > 0 then
               FAnsi.Write(S);
+          until Length(S) = 0;
+        finally
+          FAnsi.EndUpdate;
+        end;
       end;
   end;
 end;
@@ -131,7 +141,7 @@ begin
   FEditSettings.Left   := 148;
   FEditSettings.Top    := 8;
   FEditSettings.Width  := 140;
-  FEditSettings.Text   := '9600,N,8,1';
+  FEditSettings.Text   := '115200,N,8,1';
 
   FBtnOpen := TButton.Create(Self);
   FBtnOpen.Parent  := Self;
@@ -164,6 +174,15 @@ begin
   FAnsi.Left      := 0;
   FAnsi.Top       := 38;
   FAnsi.OnKeyData := AnsiKeyData;
+
+  { Font diagnostic: write known CP437 box-drawing characters.         }
+  { If the OEM font is working, you should see:                        }
+  {   Line 1: single-line box top    ┌───┐                             }
+  {   Line 2: shade + full block     ░▒▓█                              }
+  {   Line 3: single-line box bottom └───┘                             }
+  { If you see accented letters (Ú Ä ¿ ° ± ² Û À Ù), the font is     }
+  { ANSI_CHARSET instead of OEM_CHARSET.                               }
+  FAnsi.Write(#$DA#$C4#$C4#$C4#$BF' '#$B0#$B1#$B2#$DB' '#$C0#$C4#$C4#$C4#$D9#13#10);
 end;
 
 

drv/commdrv.c

@@ -259,6 +259,13 @@ void applyBaudRate(PortStateT *port, uint16_t baud)
     base    = port->baseAddr;
     divisor = (uint16_t)(BAUD_DIVISOR_BASE / actualBaud);
 
+    // Guard: divisor 0 means the UART treats it as 65536, giving ~1.76 baud.
+    // This can happen when BuildCommDCB stores a raw truncated value for
+    // 115200 (e.g. 0xE101 = 57601) and a future rate exceeds 115200.
+    if (divisor == 0) {
+        divisor = 1;
+    }
+
     // Set DLAB to access divisor latch
     lcr = (uint8_t)_inp(base + UART_LCR);
     _outp(base + UART_LCR, lcr | LCR_DLAB);
@@ -315,6 +322,11 @@ void applyLineParams(PortStateT *port, uint8_t byteSize, uint8_t parity, uint8_t
             break;
     }
 
+    dbgHex16("KPCOMM: applyLine byteSize", (uint16_t)byteSize);
+    dbgHex16("KPCOMM: applyLine parity", (uint16_t)parity);
+    dbgHex16("KPCOMM: applyLine stopBits", (uint16_t)stopBits);
+    dbgHex16("KPCOMM: applyLine LCR", (uint16_t)lcr);
+
     _outp(base + UART_LCR, lcr);
 
     port->byteSize = byteSize;
@@ -952,6 +964,8 @@ int16_t FAR PASCAL _export inicom(DCB FAR *dcb)
     port->comDeb.baudRate   = port->baudRate;
     port->comDeb.qInSize    = port->rxSize;
     port->comDeb.qOutSize   = port->txSize;
+    port->comDeb.lcrShadow  = (uint8_t)_inp(port->baseAddr + UART_LCR);
+    port->comDeb.mcrShadow  = (uint8_t)_inp(port->baseAddr + UART_MCR);
 
     // Enable receive and line status interrupts
     _outp(port->baseAddr + UART_IER, IER_RDA | IER_LSI | IER_MSI);
@@ -1101,7 +1115,9 @@ void primeTx(PortStateT *port)
 // reactivateOpenCommPorts - Reactivate all ports after task switch (ordinal 18)
 //
 // Called by Windows when switching back to this VM.
-// Re-enables interrupts and restores MCR state.
+// Restores full UART state: baud rate, line params (LCR), MCR, FIFOs,
+// and re-enables interrupts.  A DOS fullscreen app or VM switch may
+// have reprogrammed the UART, so we must restore everything.
 // -----------------------------------------------------------------------
 void FAR PASCAL _export reactivateOpenCommPorts(void)
 {
@@ -1117,6 +1133,12 @@ void FAR PASCAL _export reactivateOpenCommPorts(void)
             continue;
         }
 
+        // Restore baud rate (sets DLAB, writes divisor, clears DLAB)
+        applyBaudRate(port, port->baudRate);
+
+        // Restore line parameters (word length, parity, stop bits)
+        applyLineParams(port, port->byteSize, port->parity, port->stopBits);
+
         // Restore MCR (DTR, RTS, OUT2)
         mcr = MCR_OUT2;
         if (port->dtrState) {