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>
201 lines
5.3 KiB
ObjectPascal
201 lines
5.3 KiB
ObjectPascal
unit TestMain;
|
|
|
|
{ Test application for TKPComm and TKPAnsi components. }
|
|
{ Form and all controls are created in code (no DFM required). }
|
|
{ }
|
|
{ Layout: toolbar row at top (port, settings, open/close, status), }
|
|
{ TKPAnsi terminal filling the rest of the form. Received serial data }
|
|
{ is fed to the terminal via TKPAnsi.Write; keystrokes from the terminal }
|
|
{ are sent out via TKPComm.Output. }
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, WinTypes, WinProcs, Messages,
|
|
Forms, Controls, StdCtrls, KPComm, KPAnsi;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
private
|
|
FComm: TKPComm;
|
|
FAnsi: TKPAnsi;
|
|
FLabelPort: TLabel;
|
|
FEditPort: TEdit;
|
|
FLabelSettings: TLabel;
|
|
FEditSettings: TEdit;
|
|
FBtnOpen: TButton;
|
|
FBtnClose: TButton;
|
|
FLabelStatus: TLabel;
|
|
procedure AnsiKeyData(Sender: TObject; const Data: string);
|
|
procedure BtnCloseClick(Sender: TObject);
|
|
procedure BtnOpenClick(Sender: TObject);
|
|
procedure CommEvent(Sender: TObject);
|
|
procedure UpdateStatus;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
implementation
|
|
|
|
|
|
procedure TMainForm.AnsiKeyData(Sender: TObject; const Data: string);
|
|
begin
|
|
if FComm.PortOpen and (Length(Data) > 0) then
|
|
begin
|
|
try
|
|
FComm.Output := Data;
|
|
except
|
|
on E: Exception do
|
|
{ Ignore send errors from keyboard input }
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.BtnCloseClick(Sender: TObject);
|
|
begin
|
|
FComm.PortOpen := False;
|
|
UpdateStatus;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.BtnOpenClick(Sender: TObject);
|
|
begin
|
|
try
|
|
FComm.CommPort := StrToInt(FEditPort.Text);
|
|
FComm.Settings := FEditSettings.Text;
|
|
FComm.RThreshold := 1;
|
|
FComm.PortOpen := True;
|
|
except
|
|
on E: Exception do
|
|
FAnsi.Write('Open failed: ' + E.Message + #13#10);
|
|
end;
|
|
UpdateStatus;
|
|
FAnsi.SetFocus;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.CommEvent(Sender: TObject);
|
|
var
|
|
S: string;
|
|
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;
|
|
|
|
|
|
constructor TMainForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited CreateNew(AOwner);
|
|
|
|
Caption := 'KPComm ANSI Terminal';
|
|
Width := 660;
|
|
Height := 460;
|
|
BorderStyle := bsSingle;
|
|
|
|
{ Serial component }
|
|
FComm := TKPComm.Create(Self);
|
|
FComm.OnComm := CommEvent;
|
|
|
|
{ Row 1: Port and Settings }
|
|
FLabelPort := TLabel.Create(Self);
|
|
FLabelPort.Parent := Self;
|
|
FLabelPort.Left := 8;
|
|
FLabelPort.Top := 12;
|
|
FLabelPort.Caption := 'Port:';
|
|
|
|
FEditPort := TEdit.Create(Self);
|
|
FEditPort.Parent := Self;
|
|
FEditPort.Left := 44;
|
|
FEditPort.Top := 8;
|
|
FEditPort.Width := 32;
|
|
FEditPort.Text := '1';
|
|
|
|
FLabelSettings := TLabel.Create(Self);
|
|
FLabelSettings.Parent := Self;
|
|
FLabelSettings.Left := 88;
|
|
FLabelSettings.Top := 12;
|
|
FLabelSettings.Caption := 'Settings:';
|
|
|
|
FEditSettings := TEdit.Create(Self);
|
|
FEditSettings.Parent := Self;
|
|
FEditSettings.Left := 148;
|
|
FEditSettings.Top := 8;
|
|
FEditSettings.Width := 140;
|
|
FEditSettings.Text := '115200,N,8,1';
|
|
|
|
FBtnOpen := TButton.Create(Self);
|
|
FBtnOpen.Parent := Self;
|
|
FBtnOpen.Left := 300;
|
|
FBtnOpen.Top := 8;
|
|
FBtnOpen.Width := 65;
|
|
FBtnOpen.Height := 25;
|
|
FBtnOpen.Caption := 'Open';
|
|
FBtnOpen.OnClick := BtnOpenClick;
|
|
|
|
FBtnClose := TButton.Create(Self);
|
|
FBtnClose.Parent := Self;
|
|
FBtnClose.Left := 372;
|
|
FBtnClose.Top := 8;
|
|
FBtnClose.Width := 65;
|
|
FBtnClose.Height := 25;
|
|
FBtnClose.Caption := 'Close';
|
|
FBtnClose.Enabled := False;
|
|
FBtnClose.OnClick := BtnCloseClick;
|
|
|
|
FLabelStatus := TLabel.Create(Self);
|
|
FLabelStatus.Parent := Self;
|
|
FLabelStatus.Left := 450;
|
|
FLabelStatus.Top := 12;
|
|
FLabelStatus.Caption := 'Closed';
|
|
|
|
{ ANSI terminal }
|
|
FAnsi := TKPAnsi.Create(Self);
|
|
FAnsi.Parent := Self;
|
|
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;
|
|
|
|
|
|
procedure TMainForm.UpdateStatus;
|
|
begin
|
|
if FComm.PortOpen then
|
|
FLabelStatus.Caption := 'Open'
|
|
else
|
|
FLabelStatus.Caption := 'Closed';
|
|
|
|
FBtnOpen.Enabled := not FComm.PortOpen;
|
|
FBtnClose.Enabled := FComm.PortOpen;
|
|
end;
|
|
|
|
|
|
end.
|