252 lines
7 KiB
ObjectPascal
252 lines
7 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 polled from TKPComm.Input in a PeekMessage main loop; 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
|
|
{ Components (owned by Self, freed automatically) }
|
|
FComm: TKPComm; { Serial communications component }
|
|
FAnsi: TKPAnsi; { ANSI terminal display }
|
|
|
|
{ Toolbar controls }
|
|
FLabelPort: TLabel; { "Port:" label }
|
|
FEditPort: TEdit; { COM port number entry }
|
|
FLabelSettings: TLabel; { "Settings:" label }
|
|
FEditSettings: TEdit; { Baud/parity/data/stop entry }
|
|
FBtnOpen: TButton; { Opens the serial port }
|
|
FBtnClose: TButton; { Closes the serial port }
|
|
FLabelStatus: TLabel; { Displays "Open" or "Closed" }
|
|
|
|
FDone: Boolean; { True when WM_QUIT received }
|
|
procedure AnsiKeyData(Sender: TObject; const Data: string);
|
|
procedure BtnCloseClick(Sender: TObject);
|
|
procedure BtnOpenClick(Sender: TObject);
|
|
procedure UpdateStatus;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure Run;
|
|
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.PortOpen := True;
|
|
except
|
|
on E: Exception do
|
|
FAnsi.Write('Open failed: ' + E.Message + #13#10);
|
|
end;
|
|
UpdateStatus;
|
|
FAnsi.SetFocus;
|
|
end;
|
|
|
|
|
|
constructor TMainForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited CreateNew(AOwner);
|
|
|
|
Caption := 'KPComm ANSI Terminal';
|
|
Width := 780;
|
|
Height := 560;
|
|
BorderStyle := bsSingle;
|
|
|
|
{ Serial component }
|
|
FComm := TKPComm.Create(Self);
|
|
|
|
{ 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.Run;
|
|
const
|
|
BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit }
|
|
var
|
|
Msg: TMsg;
|
|
Buf: array[0..BufSize - 1] of Char;
|
|
Len: Integer;
|
|
HasData: Boolean;
|
|
begin
|
|
Show;
|
|
FDone := False;
|
|
while not FDone do
|
|
begin
|
|
{ Process all pending Windows messages (keyboard, paint, scrollbar) }
|
|
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do
|
|
begin
|
|
if Msg.message = wm_Quit then
|
|
begin
|
|
FDone := True;
|
|
Break;
|
|
end;
|
|
TranslateMessage(Msg);
|
|
DispatchMessage(Msg);
|
|
end;
|
|
|
|
if FDone then
|
|
Break;
|
|
|
|
{ Drain all available serial data. WriteDeferredBuf renders each }
|
|
{ character run immediately via ExtTextOut -- no deferred pass. }
|
|
{ Messages are checked between chunks so keyboard stays responsive. }
|
|
HasData := False;
|
|
if FComm.PortOpen then
|
|
begin
|
|
Len := FComm.ReadInputBuf(@Buf, BufSize);
|
|
while (Len > 0) and not FDone do
|
|
begin
|
|
FAnsi.WriteDeferredBuf(@Buf, Len);
|
|
HasData := True;
|
|
{ Check for messages between chunks }
|
|
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do
|
|
begin
|
|
if Msg.message = wm_Quit then
|
|
begin
|
|
FDone := True;
|
|
Break;
|
|
end;
|
|
TranslateMessage(Msg);
|
|
DispatchMessage(Msg);
|
|
end;
|
|
Len := FComm.ReadInputBuf(@Buf, BufSize);
|
|
end;
|
|
end;
|
|
|
|
if FDone then
|
|
Break;
|
|
|
|
{ Blink + dirty-row pass. During normal data flow, WriteDeferredBuf }
|
|
{ already rendered inline so FlipToScreen is a no-op. Only blink }
|
|
{ toggle (every 500ms) or scrollbar updates produce dirty rows here. }
|
|
FAnsi.TickBlink;
|
|
FAnsi.FlipToScreen;
|
|
|
|
{ Yield CPU to other apps when no serial data is flowing. }
|
|
{ PM_NOYIELD keeps message draining fast; Yield here gives other }
|
|
{ apps a timeslice only when idle. During bulk data flow, HasData }
|
|
{ stays True and the loop runs at full speed. }
|
|
if not HasData then
|
|
Yield;
|
|
end;
|
|
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.
|