{
 -------------------------------------------------------------------------
 Copyright (C) 1998-2003 Häger+Busch                   / >>>>>>>>> /-----
 Ingenieurbuero fuer Kommunikationslösungen           / <<<<<<<<< /
 ----------------------------------------------------/ >>>>>>>>> /
 All rights reserved.
                                                    http://www.commso.com

 Project     : hbTapi Components
 Modul       : Sample DataTerm

 Description : This sample shows how to use TComPort to build a
               simple termional application.

 History     : [-] Fixed [+] Added [*] Improved

 01/01/03   Creation
}
unit uMain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ExtCtrls, StdCtrls, hbTAPIComm;
type
  TForm1 = class(TForm)
    MainMenu: TMainMenu;
    menuLine: TMenuItem;
    menuOnLine: TMenuItem;
    menuOffline: TMenuItem;
    menuExit: TMenuItem;
    menuChange: TMenuItem;
    menuPort: TMenuItem;
    menuBaud: TMenuItem;
    menuDataBits: TMenuItem;
    menuParity: TMenuItem;
    menuStopBits: TMenuItem;
    menuCOM1: TMenuItem;
    menuCOM2: TMenuItem;
    menuCOM3: TMenuItem;
    menuCOM4: TMenuItem;
    menu300: TMenuItem;
    menu1200: TMenuItem;
    menu2400: TMenuItem;
    menu4800: TMenuItem;
    menu9600: TMenuItem;
    menu19200: TMenuItem;
    menu38400: TMenuItem;
    menu57600: TMenuItem;
    menuSeven: TMenuItem;
    menuEight: TMenuItem;
    menuNone: TMenuItem;
    menuEven: TMenuItem;
    menuOdd: TMenuItem;
    menuOne: TMenuItem;
    menuTwo: TMenuItem;
    menuStatus: TMenuItem;
    menuControl: TMenuItem;
    menuFlowControl: TMenuItem;
    menuHardware: TMenuItem;
    menuSoftware: TMenuItem;
    menuNoFlow: TMenuItem;
    menuDTR: TMenuItem;
    menuRTS: TMenuItem;
    menuDTRset: TMenuItem;
    menuDTRclear: TMenuItem;
    menuRTSset: TMenuItem;
    menuRTSclear: TMenuItem;
    MemoMain: TMemo;
    menuOne5: TMenuItem;
    ComPort1: TComPort;
    menuClear: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure menuOnLineClick(Sender: TObject);
    procedure menuOfflineClick(Sender: TObject);
    procedure menuCOM1Click(Sender: TObject);
    procedure menuCOM2Click(Sender: TObject);
    procedure menuCOM3Click(Sender: TObject);
    procedure menuCOM4Click(Sender: TObject);
    procedure menuExitClick(Sender: TObject);
    procedure menu300Click(Sender: TObject);
    procedure menu1200Click(Sender: TObject);
    procedure menu2400Click(Sender: TObject);
    procedure menu4800Click(Sender: TObject);
    procedure menu9600Click(Sender: TObject);
    procedure menu19200Click(Sender: TObject);
    procedure menu38400Click(Sender: TObject);
    procedure menu57600Click(Sender: TObject);
    procedure menuSevenClick(Sender: TObject);
    procedure menuEightClick(Sender: TObject);
    procedure menuNoneClick(Sender: TObject);
    procedure menuEvenClick(Sender: TObject);
    procedure menuOddClick(Sender: TObject);
    procedure menuOneClick(Sender: TObject);
    procedure menuTwoClick(Sender: TObject);
    procedure DoKeyPress(Sender: TObject; var Key: Char);
    procedure Status(Sender: TObject);
    procedure menuDTRsetClick(Sender: TObject);
    procedure menuRTSsetClick(Sender: TObject);
    procedure menuDTRclearClick(Sender: TObject);
    procedure menuRTSclearClick(Sender: TObject);
    procedure menuHardwareClick(Sender: TObject);
    procedure menuSoftwareClick(Sender: TObject);
    procedure menuNoFlowClick(Sender: TObject);
    procedure menuOne5Click(Sender: TObject);
    procedure ComPort1DSR(Sender: TObject);
    procedure ComPort1CTS(Sender: TObject);
    procedure ComPort1DCD(Sender: TObject);
    procedure menuClearClick(Sender: TObject);
    procedure ComPort1BREAK(Sender: TObject);
    procedure ComPort1CommError(Sender: TObject; Error: Cardinal);
    procedure ComPort1Receive(Sender: TObject);
  private
    { Private declarations }
    Port     : String;
    Baud     : Integer;
    Parity   : Char;
    DataBits : Integer;
    StopBits : Integer;
    procedure UpdateStatus;
  public
    { Public declarations }
  end ;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  (* initialize parameters *)
  Port     := 'COM1';
  Baud     := 19200;
  Parity   := 'N';
  DataBits := 8;
  StopBits := 1;

  menuOffLine.Checked := true;
  menuCOM1.Checked := true;
  menu19200.Checked := true;
  menuNone.Checked := true;
  menuEight.Checked := true;
  menuOne.Checked := true;
  menuDTRset.Checked := true;
  menuDTRclear.Checked := false;
  menuRTSset.Checked := true;
  menuRTSclear.Checked := false;
  UpdateStatus;
end;

procedure TForm1.menuOnLineClick(Sender: TObject);
begin
  ComPort1.PortName := Port;
  ComPort1.Baud     := Baud;
  ComPort1.Parity   := Parity;
  ComPort1.DataBits := DataBits;
  ComPort1.StopBits := StopBits;

  ComPort1.Active := True;

  menuOnLine.Checked   := true;
  menuOffLine.Checked  := false;
  menuChange.Enabled   := false;
  menuStatus.Enabled   := true;
  menuControl.Enabled  := true;
  menuFlowControl.Enabled := true;
  menuNoFlow.Checked      := true;

  MemoMain.SetFocus;
  UpdateStatus;
end;

procedure TForm1.menuOfflineClick(Sender: TObject);
begin
  ComPort1.Active        := False;
  menuOnLine.Checked     := false;
  menuOffLine.Checked    := true;
  menuChange.Enabled     := true;
  menuStatus.Enabled     := false;
  menuControl.Enabled    := false;
  menuFlowControl.Enabled:= false;
  UpdateStatus;
end;

procedure TForm1.menuCOM1Click(Sender: TObject);
begin
  menuCOM1.Checked := true;
  menuCOM2.Checked := false;
  menuCOM3.Checked := false;
  menuCOM4.Checked := false;
  Port := 'COM1';
end;

procedure TForm1.menuCOM2Click(Sender: TObject);
begin
  menuCOM1.Checked := false;
  menuCOM2.Checked := true;
  menuCOM3.Checked := false;
  menuCOM4.Checked := false;
  Port := 'COM2';
end;

procedure TForm1.menuCOM3Click(Sender: TObject);
begin
  menuCOM1.Checked := false;
  menuCOM2.Checked := false;
  menuCOM3.Checked := true;
  menuCOM4.Checked := false;
  Port := 'COM3';
end;

procedure TForm1.menuCOM4Click(Sender: TObject);
begin
  menuCOM1.Checked := false;
  menuCOM2.Checked := false;
  menuCOM3.Checked := false;
  menuCOM4.Checked := true;
  Port := 'COM4';
end;

procedure TForm1.menuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.menu300Click(Sender: TObject);
begin
  menu300.Checked   := true;
  menu1200.Checked  := false;
  menu2400.Checked  := false;
  menu4800.Checked  := false;
  menu9600.Checked  := false;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 300;
end;

procedure TForm1.menu1200Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := true;
  menu2400.Checked := false;
  menu4800.Checked := false;
  menu9600.Checked := false;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 1200;
end;

procedure TForm1.menu2400Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := true;
  menu4800.Checked := false;
  menu9600.Checked := false;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 2400;
end;

procedure TForm1.menu4800Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := false;
  menu4800.Checked := true;
  menu9600.Checked := false;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 4800;
end;

procedure TForm1.menu9600Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := false;
  menu4800.Checked := false;
  menu9600.Checked := true;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 9600
end;

procedure TForm1.menu19200Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := false;
  menu4800.Checked := false;
  menu9600.Checked := false;
  menu19200.Checked := true;
  menu38400.Checked := false;
  menu57600.Checked := false;
  Baud              := 19200;
end;

procedure TForm1.menu38400Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := false;
  menu4800.Checked := false;
  menu9600.Checked := false;
  menu19200.Checked := false;
  menu38400.Checked := true;
  menu57600.Checked := false;
  Baud              := 38400;
end;

procedure TForm1.menu57600Click(Sender: TObject);
begin
  menu300.Checked := false;
  menu1200.Checked := false;
  menu2400.Checked := false;
  menu4800.Checked := false;
  menu9600.Checked := false;
  menu19200.Checked := false;
  menu38400.Checked := false;
  menu57600.Checked := true;
  Baud              := 57600;
end;

procedure TForm1.menuSevenClick(Sender: TObject);
begin
  menuSeven.Checked := true;
  menuEight.Checked := false;
  DataBits          := 7;
end;

procedure TForm1.menuEightClick(Sender: TObject);
begin
  menuSeven.Checked := false;
  menuEight.Checked := true;
  DataBits          := 8;
end;

procedure TForm1.menuNoneClick(Sender: TObject);
begin
  menuNone.Checked := true;
  menuEven.Checked := false;
  menuOdd.Checked  := false;
  Parity           := 'N';
end;

procedure TForm1.menuEvenClick(Sender: TObject);
begin
  menuNone.Checked := false;
  menuEven.Checked := true;
  menuOdd.Checked  := false;
  Parity           := 'E';
end;

procedure TForm1.menuOddClick(Sender: TObject);
begin
  menuNone.Checked := false;
  menuEven.Checked := false;
  menuOdd.Checked  := true;
  Parity           := 'O';
end;

procedure TForm1.menuOneClick(Sender: TObject);
begin
  menuOne.Checked := true;
  menuOne5.Checked := false;
  menuTwo.Checked := false;
  StopBits        := 1;
end;

procedure TForm1.menuTwoClick(Sender: TObject);
begin
  menuOne.Checked := false;
  menuOne5.Checked := false;
  menuTwo.Checked := true;
  StopBits        := 2;
end;

procedure TForm1.DoKeyPress(Sender: TObject; var Key: Char);
begin
  ComPort1.Write(Key);
end;

procedure TForm1.Status(Sender: TObject);
begin
  if ComPort1.DSR then
    MemoMain.Lines.Add('[DSR is set]')
  else
    MemoMain.Lines.Add('[DSR is clear]');

  if ComPort1.CTS then
    MemoMain.Lines.Add('[CTS is set]')
  else
    MemoMain.Lines.Add('[CTS is clear]');

  if ComPort1.DCD then
    MemoMain.Lines.Add('[DCD is set]')
  else
    MemoMain.Lines.Add('[DCD is clear]');
end;

procedure TForm1.menuDTRsetClick(Sender: TObject);
begin
  ComPort1.DTR := True;
  menuDTRset.Checked := true;
  menuDTRclear.Checked := false
end;

procedure TForm1.menuRTSsetClick(Sender: TObject);
begin
  ComPort1.RTS := True;
  menuRTSset.Checked := true;
  menuRTSclear.Checked := false
end;

procedure TForm1.menuDTRclearClick(Sender: TObject);
begin
  ComPort1.DTR := False;
  menuDTRclear.Checked := true;
  menuDTRset.Checked := false
end;

procedure TForm1.menuRTSclearClick(Sender: TObject);
begin
  ComPort1.RTS := False;
  menuRTSclear.Checked := true;
  menuRTSset.Checked := false
end;

procedure TForm1.menuHardwareClick(Sender: TObject);
begin
  ComPort1.FlowControl := [fcUseRTS, fcRequireCTS];
  menuHardware.Checked := true;
  menuSoftware.Checked := false;
  menuNoFlow.Checked   := false
end;

procedure TForm1.menuSoftwareClick(Sender: TObject);
begin
  ComPort1.FlowControl := [fcUseXonXoff, fcRequireXonXoff];
  menuHardware.Checked := false;
  menuSoftware.Checked := true;
  menuNoFlow.Checked   := false
end;

procedure TForm1.menuNoFlowClick(Sender: TObject);
begin
  ComPort1.FlowControl := [];
  menuHardware.Checked := false;
  menuSoftware.Checked := false;
  menuNoFlow.Checked   := true
end;

procedure TForm1.menuOne5Click(Sender: TObject);
begin
  menuOne.Checked      := false;
  menuOne5.Checked     := true;
  menuTwo.Checked      := false;
  StopBits             := 15;
end;

procedure TForm1.ComPort1DSR(Sender: TObject);
begin
  if ComPort1.DSR then
    MemoMain.Lines.Add('[DSR is set]')
  else
    MemoMain.Lines.Add('[DSR is clear]')
end;

procedure TForm1.ComPort1CTS(Sender: TObject);
begin
{  if ComPort1.CTS then
    MemoMain.Lines.Add('[CTS is set]')
  else
    MemoMain.Lines.Add('[CTS is clear]')
}
end;

procedure TForm1.ComPort1DCD(Sender: TObject);
begin
{  if ComPort1.DCD then
    MemoMain.Lines.Add('[DCD is set]')
  else
    MemoMain.Lines.Add('[DCD is clear]')
}
end;

procedure TForm1.menuClearClick(Sender: TObject);
begin
  MemoMain.Lines.Clear;
end;

procedure TForm1.ComPort1BREAK(Sender: TObject);
begin
  MemoMain.Lines.Add('[BREAK detected]')
end;

procedure TForm1.ComPort1CommError(Sender: TObject; Error: Cardinal);
begin
  case Error of
    CE_FRAME    : MemoMain.Lines.Add('[FRAME Error]');
    CE_OVERRUN  : MemoMain.Lines.Add('[OVERRUN Error]');
    CE_RXPARITY : MemoMain.Lines.Add('[PARITY Error]');
  end;
end;

procedure TForm1.ComPort1Receive(Sender: TObject);
var
  S1, S2 : String; i: integer;
begin
  S1 := ComPort1.Read(ComPort1.InCount);
  S2 := '';
  for i := 1 to length(S1) do
  begin
    if ord(S1[i]) < ord(' ') then
//      s2 := s2 + '<' + IntToStr(ord(s1[i])) + '>'
    else
      s2 := s2 + s1[i];
    if ord(s1[i]) = 10 then
    begin
      if MemoMain.Lines.Count = 0 then
        MemoMain.Lines.Add(s2)
      else
        MemoMain.Lines[MemoMain.Lines.Count-1] := MemoMain.Lines[MemoMain.Lines.Count-1] + s2;
      MemoMain.Lines.Add('');
      s2 := '';
    end;
  end;
  if MemoMain.Lines.Count = 0 then
    MemoMain.Lines.Add(s2)
  else
    MemoMain.Lines[MemoMain.Lines.Count-1] := MemoMain.Lines[MemoMain.Lines.Count-1] + s2;
end;

procedure TForm1.UpdateStatus;
begin
  with ComPort1 do
  begin
    if active then
      Caption := Format('%s online (%d, %d, %s, %d)', [PortName, Baud, Databits, Parity, Stopbits])
    else
      Caption := Format('Offline', []);
  end;
end;


end.
