diff --git a/delphi/KPCOMM.PAS b/delphi/KPCOMM.PAS new file mode 100644 index 0000000..1d1b081 --- /dev/null +++ b/delphi/KPCOMM.PAS @@ -0,0 +1,734 @@ +unit KPComm; + +{ KPComm - Native Delphi 1.0 serial communications component. } +{ } +{ TKPComm is a non-visual TComponent descendant providing RS-232 serial } +{ I/O via the Windows 3.1 comm API. Installs to the "KP" palette tab. } +{ } +{ Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> } +{ EnableCommNotification -> CloseComm. } +{ } +{ WM_COMMNOTIFY messages are received through a hidden utility window } +{ with a registered class and dispatched to ProcessReceiveNotify, } +{ ProcessTransmitNotify, and ProcessEventNotify. } +{ } +{ Modem line status (CTS/DSR/CD) is tracked via shadow booleans toggled } +{ on transition events from GetCommEventMask, since the 16-bit comm API } +{ only provides transition events, not absolute line levels. } + +interface + +uses + SysUtils, Classes, WinTypes, WinProcs, Messages; + +const + { Communication events } + comEvReceive = 1; + comEvSend = 2; + comEvCTS = 3; + comEvDSR = 4; + comEvCD = 5; + comEvRing = 6; + comEvEOF = 7; + + { Error events } + comEvtBreak = 1001; + comEvtFrame = 1004; + comEvtOverrun = 1006; + comEvtRxOver = 1008; + comEvtParity = 1009; + comEvtTxFull = 1010; + +type + THandshaking = (hsNone, hsXonXoff, hsRtsCts, hsBoth); + TInputMode = (imText, imBinary); + + TKPComm = class(TComponent) + private + FCommId: Integer; + FHWndNotify: HWnd; + FCommPort: Integer; + FSettings: string; + FPortOpen: Boolean; + FInBufferSize: Integer; + FOutBufferSize: Integer; + FRThreshold: Integer; + FSThreshold: Integer; + FHandshaking: THandshaking; + FInputLen: Integer; + FInputMode: TInputMode; + FDTREnable: Boolean; + FRTSEnable: Boolean; + FNullDiscard: Boolean; + FEOFEnable: Boolean; + FParityReplace: string; + FBreakState: Boolean; + FCommEvent: Integer; + FCTSState: Boolean; + FDSRState: Boolean; + FCDState: Boolean; + FOnComm: TNotifyEvent; + procedure ApplyHandshaking; + procedure ApplyOptions; + procedure ClosePort; + procedure DoCommEvent(EventCode: Integer); + function GetInBufferCount: Integer; + function GetInput: string; + function GetOutBufferCount: Integer; + procedure OpenPort; + procedure ProcessEventNotify; + procedure ProcessReceiveNotify; + procedure ProcessTransmitNotify; + procedure SetBreak(Value: Boolean); + procedure SetCommPort(Value: Integer); + procedure SetDTREnable(Value: Boolean); + procedure SetHandshaking(Value: THandshaking); + procedure SetInBufferSize(Value: Integer); + procedure SetNullDiscard(Value: Boolean); + procedure SetOutBufferSize(Value: Integer); + procedure SetOutput(const Value: string); + procedure SetParityReplace(const Value: string); + procedure SetPortOpen(Value: Boolean); + procedure SetRTSEnable(Value: Boolean); + procedure SetSettings(const Value: string); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Input: string read GetInput; + property Output: string write SetOutput; + property InBufferCount: Integer read GetInBufferCount; + property OutBufferCount: Integer read GetOutBufferCount; + property CDHolding: Boolean read FCDState; + property CTSHolding: Boolean read FCTSState; + property DSRHolding: Boolean read FDSRState; + property Break: Boolean read FBreakState write SetBreak; + property CommEvent: Integer read FCommEvent; + published + property CommPort: Integer read FCommPort write SetCommPort default 1; + property Settings: string read FSettings write SetSettings; + property PortOpen: Boolean read FPortOpen write SetPortOpen default False; + property InBufferSize: Integer read FInBufferSize write SetInBufferSize default 4096; + property OutBufferSize: Integer read FOutBufferSize write SetOutBufferSize default 4096; + property RThreshold: Integer read FRThreshold write FRThreshold default 0; + property SThreshold: Integer read FSThreshold write FSThreshold default 0; + property Handshaking: THandshaking read FHandshaking write SetHandshaking default hsNone; + property InputLen: Integer read FInputLen write FInputLen default 0; + property InputMode: TInputMode read FInputMode write FInputMode default imText; + property DTREnable: Boolean read FDTREnable write SetDTREnable default True; + property RTSEnable: Boolean read FRTSEnable write SetRTSEnable default True; + property NullDiscard: Boolean read FNullDiscard write SetNullDiscard default False; + property EOFEnable: Boolean read FEOFEnable write FEOFEnable default False; + property ParityReplace: string read FParityReplace write SetParityReplace; + property OnComm: TNotifyEvent read FOnComm write FOnComm; + end; + +procedure Register; + +implementation + +const + { WM_COMMNOTIFY notification codes } + CN_RECEIVE = $0001; + CN_TRANSMIT = $0002; + CN_EVENT = $0004; + + { DCB Flags field bit masks. The Windows 3.1 DCB packs thirteen 1-bit } + { fields into a single UINT (Word) at offset 12 of the structure. } + { Delphi 1.0 maps this UINT to TDCB.Flags. } + dcbBinary = $0001; + dcbRtsDisable = $0002; + dcbParity = $0004; + dcbOutxCtsFlow = $0008; + dcbOutxDsrFlow = $0010; + dcbDtrDisable = $0020; + dcbOutX = $0040; + dcbInX = $0080; + dcbPeChar = $0100; + dcbNull = $0200; + dcbChEvt = $0400; + dcbDtrflow = $0800; + dcbRtsflow = $1000; + + { Hidden notification window class name } + NotifyClassName = 'KPCommNotify'; + +var + NotifyClassRegistered: Boolean; + + +{ ----------------------------------------------------------------------- } +{ Hidden notification window procedure } +{ } +{ Receives WM_COMMNOTIFY from the comm driver. Retrieves the TKPComm } +{ instance pointer stored in the window's extra bytes (offset 0) and } +{ dispatches to the appropriate Process* method. } +{ ----------------------------------------------------------------------- } + +function NotifyWndProc(Wnd: HWnd; Msg: Word; + WParam: Word; LParam: Longint): Longint; export; +var + Comm: TKPComm; + NotifyCode: Word; +begin + if Msg = wm_CommNotify then + begin + Comm := TKPComm(GetWindowLong(Wnd, 0)); + if (Comm <> nil) and Comm.FPortOpen and (Comm.FCommId >= 0) then + begin + NotifyCode := Word(LParam); + if (NotifyCode and CN_RECEIVE) <> 0 then + Comm.ProcessReceiveNotify; + if (NotifyCode and CN_TRANSMIT) <> 0 then + Comm.ProcessTransmitNotify; + if (NotifyCode and CN_EVENT) <> 0 then + Comm.ProcessEventNotify; + end; + Result := 0; + end + else + Result := DefWindowProc(Wnd, Msg, WParam, LParam); +end; + + +{ ----------------------------------------------------------------------- } +{ TKPComm } +{ ----------------------------------------------------------------------- } + +procedure TKPComm.ApplyHandshaking; +var + DCB: TDCB; +begin + if GetCommState(FCommId, DCB) <> 0 then + Exit; + + { Clear all flow control flags } + DCB.Flags := DCB.Flags and + not (dcbOutxCtsFlow or dcbOutxDsrFlow or dcbOutX or dcbInX or + dcbRtsDisable or dcbRtsflow); + + case FHandshaking of + hsXonXoff: + begin + DCB.Flags := DCB.Flags or dcbOutX or dcbInX; + DCB.XonChar := #$11; + DCB.XoffChar := #$13; + DCB.XonLim := 256; + DCB.XoffLim := 256; + end; + hsRtsCts: + begin + DCB.Flags := DCB.Flags or dcbOutxCtsFlow or dcbRtsflow; + end; + hsBoth: + begin + DCB.Flags := DCB.Flags or dcbOutxCtsFlow or dcbRtsflow or + dcbOutX or dcbInX; + DCB.XonChar := #$11; + DCB.XoffChar := #$13; + DCB.XonLim := 256; + DCB.XoffLim := 256; + end; + end; + + DCB.Id := FCommId; + SetCommState(DCB); +end; + + +procedure TKPComm.ApplyOptions; +var + DCB: TDCB; +begin + if GetCommState(FCommId, DCB) <> 0 then + Exit; + + if FNullDiscard then + DCB.Flags := DCB.Flags or dcbNull + else + DCB.Flags := DCB.Flags and not dcbNull; + + if Length(FParityReplace) > 0 then + begin + DCB.Flags := DCB.Flags or dcbParity; + DCB.PeChar := FParityReplace[1]; + end + else + begin + DCB.Flags := DCB.Flags and not dcbParity; + DCB.PeChar := #0; + end; + + DCB.Id := FCommId; + SetCommState(DCB); +end; + + +procedure TKPComm.ClosePort; +begin + { Set FPortOpen first to prevent stale WM_COMMNOTIFY processing } + FPortOpen := False; + + if FCommId >= 0 then + begin + if FBreakState then + begin + ClearCommBreak(FCommId); + FBreakState := False; + end; + EscapeCommFunction(FCommId, CLRDTR); + EscapeCommFunction(FCommId, CLRRTS); + CloseComm(FCommId); + FCommId := -1; + end; + + if FHWndNotify <> 0 then + begin + DestroyWindow(FHWndNotify); + FHWndNotify := 0; + end; + + FCTSState := False; + FDSRState := False; + FCDState := False; +end; + + +constructor TKPComm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCommId := -1; + FHWndNotify := 0; + FCommPort := 1; + FSettings := '9600,N,8,1'; + FPortOpen := False; + FInBufferSize := 4096; + FOutBufferSize := 4096; + FRThreshold := 0; + FSThreshold := 0; + FHandshaking := hsNone; + FInputLen := 0; + FInputMode := imText; + FDTREnable := True; + FRTSEnable := True; + FNullDiscard := False; + FEOFEnable := False; + FParityReplace := '?'; + FBreakState := False; + FCommEvent := 0; + FCTSState := False; + FDSRState := False; + FCDState := False; +end; + + +destructor TKPComm.Destroy; +begin + if FPortOpen then + ClosePort; + inherited Destroy; +end; + + +procedure TKPComm.DoCommEvent(EventCode: Integer); +begin + FCommEvent := EventCode; + if Assigned(FOnComm) then + FOnComm(Self); +end; + + +function TKPComm.GetInBufferCount: Integer; +var + Stat: TComStat; +begin + Result := 0; + if not FPortOpen or (FCommId < 0) then + Exit; + GetCommError(FCommId, Stat); + Result := Stat.cbInQue; +end; + + +function TKPComm.GetInput: string; +var + Stat: TComStat; + BytesToRead: Integer; + BytesRead: Integer; + Buf: array[0..255] of Char; +begin + Result := ''; + if not FPortOpen or (FCommId < 0) then + Exit; + + GetCommError(FCommId, Stat); + BytesToRead := Stat.cbInQue; + + 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 + Exit; + + { Set string length and copy data directly -- preserves embedded nulls } + { for binary mode, and works correctly for text mode as well. } + Result[0] := Chr(BytesRead); + Move(Buf, Result[1], BytesRead); +end; + + +function TKPComm.GetOutBufferCount: Integer; +var + Stat: TComStat; +begin + Result := 0; + if not FPortOpen or (FCommId < 0) then + Exit; + GetCommError(FCommId, Stat); + Result := Stat.cbOutQue; +end; + + +procedure TKPComm.OpenPort; +var + WC: TWndClass; + DCB: TDCB; + Buf: array[0..255] of Char; + Setting: string; + RxTh: Integer; + TxTh: Integer; +begin + { Open the comm port } + StrPCopy(Buf, 'COM' + IntToStr(FCommPort)); + FCommId := OpenComm(Buf, FInBufferSize, FOutBufferSize); + if FCommId < 0 then + raise Exception.Create('Cannot open COM' + IntToStr(FCommPort) + + ' (error ' + IntToStr(FCommId) + ')'); + + { Configure baud/parity/data/stop from Settings string } + if GetCommState(FCommId, DCB) <> 0 then + begin + CloseComm(FCommId); + FCommId := -1; + raise Exception.Create('GetCommState failed'); + end; + + Setting := 'COM' + IntToStr(FCommPort) + ':' + FSettings; + StrPCopy(Buf, Setting); + if BuildCommDCB(Buf, DCB) <> 0 then + begin + CloseComm(FCommId); + FCommId := -1; + raise Exception.Create('Invalid Settings: ' + FSettings); + end; + + DCB.Flags := DCB.Flags or dcbBinary; + DCB.Id := FCommId; + if SetCommState(DCB) <> 0 then + begin + CloseComm(FCommId); + FCommId := -1; + raise Exception.Create('SetCommState failed'); + end; + + { Apply handshaking } + ApplyHandshaking; + + { Apply null-discard and parity-replace } + ApplyOptions; + + { Set DTR and RTS lines } + if FDTREnable then + EscapeCommFunction(FCommId, SETDTR) + else + EscapeCommFunction(FCommId, CLRDTR); + if FRTSEnable then + EscapeCommFunction(FCommId, SETRTS) + else + EscapeCommFunction(FCommId, CLRRTS); + + { Register notification window class (once per process) } + if not NotifyClassRegistered then + begin + FillChar(WC, SizeOf(WC), 0); + WC.lpfnWndProc := @NotifyWndProc; + WC.cbWndExtra := SizeOf(Longint); + WC.hInstance := HInstance; + WC.lpszClassName := NotifyClassName; + if not RegisterClass(WC) then + begin + CloseComm(FCommId); + FCommId := -1; + raise Exception.Create('RegisterClass failed'); + end; + NotifyClassRegistered := True; + end; + + { Create hidden notification window and store Self for dispatch } + FHWndNotify := CreateWindow(NotifyClassName, '', ws_Popup, + 0, 0, 0, 0, 0, 0, HInstance, nil); + if FHWndNotify = 0 then + begin + CloseComm(FCommId); + FCommId := -1; + raise Exception.Create('CreateWindow failed'); + end; + SetWindowLong(FHWndNotify, 0, Longint(Self)); + + { Enable event mask for modem status, errors, and breaks } + SetCommEventMask(FCommId, + ev_CTS or ev_DSR or ev_RLSD or ev_Ring or + ev_Err or ev_Break or ev_RxChar); + + { Enable comm notifications -- -1 disables the notification } + if FRThreshold > 0 then + RxTh := FRThreshold + else + RxTh := -1; + if FSThreshold > 0 then + TxTh := FSThreshold + else + TxTh := -1; + EnableCommNotification(FCommId, FHWndNotify, RxTh, TxTh); + + { Reset modem line shadow state } + FCTSState := False; + FDSRState := False; + FCDState := False; + + FPortOpen := True; +end; + + +procedure TKPComm.ProcessEventNotify; +var + EvtMask: Word; + Stat: TComStat; + ErrFlags: Integer; +begin + EvtMask := GetCommEventMask(FCommId, + ev_CTS or ev_DSR or ev_RLSD or ev_Ring or ev_Err or ev_Break); + + if (EvtMask and ev_Break) <> 0 then + DoCommEvent(comEvtBreak); + + { Modem line shadow state: toggle on each transition event. } + { The 16-bit comm API only provides transition events, not } + { absolute line levels. } + if (EvtMask and ev_CTS) <> 0 then + begin + FCTSState := not FCTSState; + DoCommEvent(comEvCTS); + end; + + if (EvtMask and ev_DSR) <> 0 then + begin + FDSRState := not FDSRState; + DoCommEvent(comEvDSR); + end; + + if (EvtMask and ev_RLSD) <> 0 then + begin + FCDState := not FCDState; + DoCommEvent(comEvCD); + end; + + if (EvtMask and ev_Ring) <> 0 then + DoCommEvent(comEvRing); + + if (EvtMask and ev_Err) <> 0 then + begin + ErrFlags := GetCommError(FCommId, Stat); + if (ErrFlags and ce_Frame) <> 0 then + DoCommEvent(comEvtFrame); + if (ErrFlags and ce_Overrun) <> 0 then + DoCommEvent(comEvtOverrun); + if (ErrFlags and ce_RxOver) <> 0 then + DoCommEvent(comEvtRxOver); + if (ErrFlags and ce_RxParity) <> 0 then + DoCommEvent(comEvtParity); + if (ErrFlags and ce_TxFull) <> 0 then + DoCommEvent(comEvtTxFull); + end; +end; + + +procedure TKPComm.ProcessReceiveNotify; +var + Stat: TComStat; +begin + if FRThreshold <= 0 then + Exit; + GetCommError(FCommId, Stat); + if Integer(Stat.cbInQue) >= FRThreshold then + DoCommEvent(comEvReceive); +end; + + +procedure TKPComm.ProcessTransmitNotify; +var + Stat: TComStat; +begin + if FSThreshold <= 0 then + Exit; + GetCommError(FCommId, Stat); + if Integer(Stat.cbOutQue) <= FSThreshold then + DoCommEvent(comEvSend); +end; + + +procedure TKPComm.SetBreak(Value: Boolean); +begin + FBreakState := Value; + if FPortOpen and (FCommId >= 0) then + begin + if FBreakState then + SetCommBreak(FCommId) + else + ClearCommBreak(FCommId); + end; +end; + + +procedure TKPComm.SetCommPort(Value: Integer); +begin + if FPortOpen then + raise Exception.Create('Cannot change CommPort while port is open'); + if (Value < 1) or (Value > 16) then + raise Exception.Create('CommPort must be 1..16'); + FCommPort := Value; +end; + + +procedure TKPComm.SetDTREnable(Value: Boolean); +begin + FDTREnable := Value; + if FPortOpen and (FCommId >= 0) then + begin + if FDTREnable then + EscapeCommFunction(FCommId, SETDTR) + else + EscapeCommFunction(FCommId, CLRDTR); + end; +end; + + +procedure TKPComm.SetHandshaking(Value: THandshaking); +begin + FHandshaking := Value; + if FPortOpen and (FCommId >= 0) then + ApplyHandshaking; +end; + + +procedure TKPComm.SetInBufferSize(Value: Integer); +begin + if FPortOpen then + raise Exception.Create('Cannot change InBufferSize while port is open'); + if Value < 64 then + raise Exception.Create('InBufferSize must be >= 64'); + FInBufferSize := Value; +end; + + +procedure TKPComm.SetNullDiscard(Value: Boolean); +begin + FNullDiscard := Value; + if FPortOpen and (FCommId >= 0) then + ApplyOptions; +end; + + +procedure TKPComm.SetOutBufferSize(Value: Integer); +begin + if FPortOpen then + raise Exception.Create('Cannot change OutBufferSize while port is open'); + if Value < 64 then + raise Exception.Create('OutBufferSize must be >= 64'); + FOutBufferSize := Value; +end; + + +procedure TKPComm.SetOutput(const Value: string); +var + Written: Integer; +begin + if not FPortOpen or (FCommId < 0) then + raise Exception.Create('Port is not open'); + if Length(Value) > 0 then + begin + Written := WriteComm(FCommId, @Value[1], Length(Value)); + if Written < 0 then + DoCommEvent(comEvtTxFull); + end; +end; + + +procedure TKPComm.SetParityReplace(const Value: string); +begin + FParityReplace := Value; + if FPortOpen and (FCommId >= 0) then + ApplyOptions; +end; + + +procedure TKPComm.SetPortOpen(Value: Boolean); +begin + if Value = FPortOpen then + Exit; + if Value then + OpenPort + else + ClosePort; +end; + + +procedure TKPComm.SetRTSEnable(Value: Boolean); +begin + FRTSEnable := Value; + if FPortOpen and (FCommId >= 0) then + begin + if FRTSEnable then + EscapeCommFunction(FCommId, SETRTS) + else + EscapeCommFunction(FCommId, CLRRTS); + end; +end; + + +procedure TKPComm.SetSettings(const Value: string); +var + DCB: TDCB; + Buf: array[0..255] of Char; + Setting: string; +begin + FSettings := Value; + if FPortOpen and (FCommId >= 0) then + begin + if GetCommState(FCommId, DCB) <> 0 then + Exit; + Setting := 'COM' + IntToStr(FCommPort) + ':' + FSettings; + StrPCopy(Buf, Setting); + if BuildCommDCB(Buf, DCB) <> 0 then + Exit; + DCB.Flags := DCB.Flags or dcbBinary; + DCB.Id := FCommId; + SetCommState(DCB); + end; +end; + + +{ ----------------------------------------------------------------------- } +{ Component registration } +{ ----------------------------------------------------------------------- } + +procedure Register; +begin + RegisterComponents('KP', [TKPComm]); +end; + +end. diff --git a/delphi/KPTEST.DPR b/delphi/KPTEST.DPR new file mode 100644 index 0000000..6b7823a --- /dev/null +++ b/delphi/KPTEST.DPR @@ -0,0 +1,11 @@ +program KPTest; + +uses + Forms, + TestMain in 'TESTMAIN.PAS', + KPComm in 'KPCOMM.PAS'; + +begin + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/delphi/TESTMAIN.PAS b/delphi/TESTMAIN.PAS new file mode 100644 index 0000000..018976f --- /dev/null +++ b/delphi/TESTMAIN.PAS @@ -0,0 +1,267 @@ +unit TestMain; + +{ Test application for the TKPComm serial communications component. } +{ Form and all controls are created in code (no DFM required). } + +interface + +uses + SysUtils, Classes, WinTypes, WinProcs, Messages, + Forms, Controls, StdCtrls, KPComm; + +type + TMainForm = class(TForm) + private + FComm: TKPComm; + FLabelPort: TLabel; + FEditPort: TEdit; + FLabelSettings: TLabel; + FEditSettings: TEdit; + FBtnOpen: TButton; + FBtnClose: TButton; + FLabelStatus: TLabel; + FLabelRecv: TLabel; + FMemoRecv: TMemo; + FEditSend: TEdit; + FBtnSend: TButton; + FLabelInfo: TLabel; + procedure BtnCloseClick(Sender: TObject); + procedure BtnOpenClick(Sender: TObject); + procedure BtnSendClick(Sender: TObject); + procedure CommEvent(Sender: TObject); + procedure UpdateStatus; + public + constructor Create(AOwner: TComponent); override; + end; + +var + MainForm: TMainForm; + +implementation + + +procedure TMainForm.BtnCloseClick(Sender: TObject); +begin + FComm.PortOpen := False; + FMemoRecv.Lines.Add('--- Port closed ---'); + UpdateStatus; +end; + + +procedure TMainForm.BtnOpenClick(Sender: TObject); +begin + try + FComm.CommPort := StrToInt(FEditPort.Text); + FComm.Settings := FEditSettings.Text; + FComm.RThreshold := 1; + FComm.PortOpen := True; + FMemoRecv.Lines.Add('--- Port opened on COM' + + FEditPort.Text + ' at ' + FEditSettings.Text + ' ---'); + except + on E: Exception do + FMemoRecv.Lines.Add('Open failed: ' + E.Message); + end; + UpdateStatus; +end; + + +procedure TMainForm.BtnSendClick(Sender: TObject); +begin + if Length(FEditSend.Text) = 0 then + Exit; + try + FComm.Output := FEditSend.Text + #13; + FMemoRecv.Lines.Add('TX: ' + FEditSend.Text); + FEditSend.Text := ''; + except + on E: Exception do + FMemoRecv.Lines.Add('Send failed: ' + E.Message); + end; + UpdateStatus; +end; + + +procedure TMainForm.CommEvent(Sender: TObject); +var + S: string; +begin + case FComm.CommEvent of + comEvReceive: + begin + S := FComm.Input; + if Length(S) > 0 then + FMemoRecv.Lines.Add('RX: ' + S); + end; + comEvCTS: + FMemoRecv.Lines.Add('CTS changed'); + comEvDSR: + FMemoRecv.Lines.Add('DSR changed'); + comEvCD: + FMemoRecv.Lines.Add('CD changed'); + comEvRing: + FMemoRecv.Lines.Add('Ring'); + comEvEOF: + FMemoRecv.Lines.Add('EOF received'); + comEvtBreak: + FMemoRecv.Lines.Add('Break received'); + comEvtFrame: + FMemoRecv.Lines.Add('Framing error'); + comEvtOverrun: + FMemoRecv.Lines.Add('Overrun error'); + comEvtRxOver: + FMemoRecv.Lines.Add('RX buffer overflow'); + comEvtParity: + FMemoRecv.Lines.Add('Parity error'); + comEvtTxFull: + FMemoRecv.Lines.Add('TX buffer full'); + end; + UpdateStatus; +end; + + +constructor TMainForm.Create(AOwner: TComponent); +begin + inherited CreateNew(AOwner); + + Caption := 'KPComm Test'; + Width := 500; + Height := 380; + 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 := '9600,N,8,1'; + + { Row 2: Open/Close buttons and status } + FBtnOpen := TButton.Create(Self); + FBtnOpen.Parent := Self; + FBtnOpen.Left := 8; + FBtnOpen.Top := 38; + FBtnOpen.Width := 65; + FBtnOpen.Height := 25; + FBtnOpen.Caption := 'Open'; + FBtnOpen.OnClick := BtnOpenClick; + + FBtnClose := TButton.Create(Self); + FBtnClose.Parent := Self; + FBtnClose.Left := 80; + FBtnClose.Top := 38; + FBtnClose.Width := 65; + FBtnClose.Height := 25; + FBtnClose.Caption := 'Close'; + FBtnClose.Enabled := False; + FBtnClose.OnClick := BtnCloseClick; + + FLabelStatus := TLabel.Create(Self); + FLabelStatus.Parent := Self; + FLabelStatus.Left := 160; + FLabelStatus.Top := 44; + FLabelStatus.Caption := 'Closed'; + + { Receive area } + FLabelRecv := TLabel.Create(Self); + FLabelRecv.Parent := Self; + FLabelRecv.Left := 8; + FLabelRecv.Top := 70; + FLabelRecv.Caption := 'Received:'; + + FMemoRecv := TMemo.Create(Self); + FMemoRecv.Parent := Self; + FMemoRecv.Left := 8; + FMemoRecv.Top := 86; + FMemoRecv.Width := 476; + FMemoRecv.Height := 186; + FMemoRecv.ScrollBars := ssVertical; + FMemoRecv.ReadOnly := True; + + { Send row } + FEditSend := TEdit.Create(Self); + FEditSend.Parent := Self; + FEditSend.Left := 8; + FEditSend.Top := 280; + FEditSend.Width := 400; + + FBtnSend := TButton.Create(Self); + FBtnSend.Parent := Self; + FBtnSend.Left := 416; + FBtnSend.Top := 280; + FBtnSend.Width := 65; + FBtnSend.Height := 25; + FBtnSend.Caption := 'Send'; + FBtnSend.Enabled := False; + FBtnSend.OnClick := BtnSendClick; + + { Status info line } + FLabelInfo := TLabel.Create(Self); + FLabelInfo.Parent := Self; + FLabelInfo.Left := 8; + FLabelInfo.Top := 316; + FLabelInfo.Width := 476; + FLabelInfo.Caption := 'RX: 0 TX: 0 Event: 0'; +end; + + +procedure TMainForm.UpdateStatus; +var + S: string; +begin + if FComm.PortOpen then + FLabelStatus.Caption := 'Open' + else + FLabelStatus.Caption := 'Closed'; + + FBtnOpen.Enabled := not FComm.PortOpen; + FBtnClose.Enabled := FComm.PortOpen; + FBtnSend.Enabled := FComm.PortOpen; + FEditSend.Enabled := FComm.PortOpen; + + S := 'RX: ' + IntToStr(FComm.InBufferCount) + + ' TX: ' + IntToStr(FComm.OutBufferCount); + if FComm.PortOpen then + begin + if FComm.CTSHolding then + S := S + ' CTS: On' + else + S := S + ' CTS: Off'; + if FComm.DSRHolding then + S := S + ' DSR: On' + else + S := S + ' DSR: Off'; + if FComm.CDHolding then + S := S + ' CD: On' + else + S := S + ' CD: Off'; + end; + S := S + ' Event: ' + IntToStr(FComm.CommEvent); + FLabelInfo.Caption := S; +end; + + +end.