240 lines
6.3 KiB
ObjectPascal
240 lines
6.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 polled from TKPComm.Input in a PeekMessage main loop; keystrokes }
|
|
{ from the terminal are sent to the serial port via TKPComm.Output. }
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, WinTypes, WinProcs, Messages,
|
|
Forms, Controls, StdCtrls, KPComm, KPAnsi;
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
private
|
|
FComm: TKPComm; { Serial communications component }
|
|
FAnsi: TKPAnsi; { ANSI terminal display }
|
|
FLabelPort: TLabel; { "Port:" caption }
|
|
FEditPort: TEdit; { COM port number entry }
|
|
FLabelSettings: TLabel; { "Settings:" caption }
|
|
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
|
|
|
|
|
|
{ OnKeyData handler: sends terminal keystrokes to the serial port }
|
|
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;
|
|
|
|
|
|
{ Reads port number and settings from the toolbar, opens the port }
|
|
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';
|
|
BorderStyle := bsSingle;
|
|
|
|
FComm := TKPComm.Create(Self);
|
|
|
|
{ Toolbar row }
|
|
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 -- FontSize controls the OEM terminal font point size. }
|
|
{ The control auto-sizes Width/Height from FontSize, Cols, and Rows. }
|
|
FAnsi := TKPAnsi.Create(Self);
|
|
FAnsi.FontSize := 12;
|
|
FAnsi.Parent := Self;
|
|
FAnsi.Left := 0;
|
|
FAnsi.Top := 38;
|
|
FAnsi.OnKeyData := AnsiKeyData;
|
|
end;
|
|
|
|
|
|
{ PeekMessage polling loop. Drains Windows messages, polls serial }
|
|
{ data from TKPComm, and yields CPU when idle. }
|
|
procedure TMainForm.Run;
|
|
const
|
|
BufSize = 2048;
|
|
var
|
|
Msg: TMsg;
|
|
Buf: array[0..BufSize - 1] of Char;
|
|
Len: Integer;
|
|
HasData: Boolean;
|
|
begin
|
|
Show;
|
|
|
|
{ Size form to fit terminal + toolbar. Show triggers handle creation }
|
|
{ and RecalcCellSize, so FAnsi.Width/Height reflect measured font. }
|
|
ClientWidth := FAnsi.Width;
|
|
ClientHeight := FAnsi.Top + FAnsi.Height;
|
|
|
|
FDone := False;
|
|
while not FDone do
|
|
begin
|
|
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;
|
|
|
|
{ Read serial data into the terminal }
|
|
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;
|
|
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;
|
|
|
|
{ Update cursor blink and repaint any dirty rows }
|
|
FAnsi.TickBlink;
|
|
FAnsi.FlipToScreen;
|
|
|
|
{ Yield CPU when no serial data is flowing }
|
|
if not HasData then
|
|
Yield;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Syncs button enabled state and status label with port open/closed }
|
|
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.
|