{
  TCommPortDriver demo
  v1.00 15/FEB/1997 First implementation
  v1.01 19/APR/1997 Some bug fixes (in the demo)
  v1.08 19/NOV/1997 
}

unit PuertoSerial;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls,ComDrv32;

type
  TFormaSerial = class(TForm)
    CommPortDriver: TCommPortDriver;
    Panel1: TPanel;
    StatusBar: TStatusBar;
    TxMemo: TMemo;
    ConnectBtn: TButton;
    DisconnectBtn: TButton;
    QuitBtn: TButton;
    ComPortRG: TRadioGroup;
    BaudRateRG: TRadioGroup;
    DataBitsRG: TRadioGroup;
    ParityRG: TRadioGroup;
    HandshakingRG: TRadioGroup;
    RxMemo: TMemo;
    Panel2: TPanel;
    Panel3: TPanel;
    ClrInMemo: TButton;
    ClrOutMemo: TButton;
    SetDTRBtn: TButton;
    ClrDTRBtn: TButton;
    SetRTSBtn: TButton;
    ClrRTSBtn: TButton;
    procedure QuitBtnClick(Sender: TObject);
    procedure TxMemoKeyPress(Sender: TObject; var Key: Char);
    procedure ConnectBtnClick(Sender: TObject);
    procedure DisconnectBtnClick(Sender: TObject);
    procedure BaudRateRGClick(Sender: TObject);
    procedure DataBitsRGClick(Sender: TObject);
    procedure ParityRGClick(Sender: TObject);
    procedure HandshakingRGClick(Sender: TObject);
    procedure ComPortRGClick(Sender: TObject);
    procedure ClrInMemoClick(Sender: TObject);
    procedure ClrOutMemoClick(Sender: TObject);
    procedure SetDTRBtnClick(Sender: TObject);
    procedure ClrDTRBtnClick(Sender: TObject);
    procedure SetRTSBtnClick(Sender: TObject);
    procedure ClrRTSBtnClick(Sender: TObject);
    procedure CommPortDriverReceiveData(Sender: TObject; DataPtr: Pointer;
      DataSize: Integer);
    procedure CommPortDriverReceivePacket(Sender: TObject; Packet: Pointer;
      DataSize: Integer);
    procedure RxMemoChange(Sender: TObject);
  private
    procedure ApplyCommSettings;
  public
  end;

var
  FormaSerial: TFormaSerial;
  CadenaLector:string[3];


function LectorSerial(cad:string):string;
implementation

//uses CaptuRap;

{$R *.DFM}

function TecleaTecla(key:word):boolean;//que pleonasmo
begin
if (key>=48)and(key<90) then
begin
try
keybd_event(key,0,0,0);//telea una m en la pantalla activa
except
end;
end;//if

end;


 procedure AgregaCadena(cad:string);
 begin
CadenaLector:=cad;
// ShowMessage(CadenaLector);
 end;


function LectorSerial(cad:string):string;
begin
LectorSerial:=CadenaLector;
// ShowMessage(CadenaLector);
end;


procedure TFormaSerial.QuitBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TFormaSerial.TxMemoKeyPress(Sender: TObject; var Key: Char);
var s: string;
begin
  if CommPortDriver.Connected then
    // Commit data only when RETURN key is pressed
    case Key of
      #13: if TxMemo.Lines.Count > 0 then
           begin

             s := TxMemo.Lines[TxMemo.Lines.Count-1];
         //   ShowMessage(s);
             CommPortDriver.SendData( pchar(s), length(s) );
             CommPortDriver.SendData( @Key, 1 );
           end
           else
             CommPortDriver.SendData( @Key, 1 );
    end;



end;

procedure TFormaSerial.ConnectBtnClick(Sender: TObject);
begin
  // Apply settings
  ApplyCommSettings;
  // Connect
  if CommPortDriver.Connect then
  begin
    // Check if device is ON. If it is off then force TCommPortDriver to prevent
    // calling ReadFile/WriteFile APIs until device is turned on.
//    if CommPortDriver.GetLineStatus = [] then
//      CommPortDriver.CheckLineStatus := true;

    ConnectBtn.Enabled := false;
    DisconnectBtn.Enabled := true;
    StatusBar.SimpleText := 'Connected';
Try
//    TxMemo.SetFocus;
except
end;
  end
  else // Error !
    begin
      StatusBar.SimpleText := 'Error: could not connect. Check COM port settings and try again.' +
                              ' (GetLastError = ' + IntToStr(GetLastError) + ')';
      MessageBeep( 0 );
    end;

end;

procedure TFormaSerial.DisconnectBtnClick(Sender: TObject);
begin
  StatusBar.SimpleText := 'Disconnected';
  CommPortDriver.Disconnect;
  DisconnectBtn.Enabled := false;
  ConnectBtn.Enabled := true;
end;

procedure TFormaSerial.BaudRateRGClick(Sender: TObject);
begin
  CommPortDriver.ComPortSpeed := TComPortBaudRate(BaudRateRG.ItemIndex);
end;

procedure TFormaSerial.DataBitsRGClick(Sender: TObject);
begin
  CommPortDriver.ComPortDataBits := TComPortDataBits(DataBitsRG.ItemIndex);
end;

procedure TFormaSerial.ParityRGClick(Sender: TObject);
begin
  CommPortDriver.ComPortParity := TComPortParity(ParityRG.ItemIndex);
end;

procedure TFormaSerial.HandshakingRGClick(Sender: TObject);
begin
  case HandshakingRG.ItemIndex of
    0: // none
      begin
//        CommPortDriver.ComPortHwHandshaking := hhNoneRTSOn;
        CommPortDriver.ComPortSwHandshaking := shNone;
      end;
    1: // RTS/CTS
      begin
        CommPortDriver.ComPortHwHandshaking := hhRTSCTS;
        CommPortDriver.ComPortSwHandshaking := shNone;
      end;
    2: // XON/XOFF
      begin
//        CommPortDriver.ComPortHwHandshaking := hhNoneRTSOn;
        CommPortDriver.ComPortSwHandshaking := shXONXOFF;
      end;
    3: // RTS/CTS + XON/XOFF
      begin
        CommPortDriver.ComPortHwHandshaking := hhRTSCTS;
        CommPortDriver.ComPortSwHandshaking := shXONXOFF;
      end;
  end;
end;

procedure TFormaSerial.ComPortRGClick(Sender: TObject);
begin
  // Apply com settings
  //ApplyCommSettings;
end;

procedure TFormaSerial.ApplyCommSettings;
var wasConnected: boolean;
begin
  wasConnected := CommPortDriver.Connected;
  // This change needs CommPortDriver not connected
  if wasConnected then
    DisconnectBtnClick( nil );

  CommPortDriver.ComPort := TComPortNumber(ord(ComPortRG.ItemIndex));
  BaudRateRGClick( nil );
  DataBitsRGClick( nil );
  ParityRGClick( nil );
  HandshakingRGClick( nil );

  // Reconnect
  try
  if wasConnected then
    ConnectBtnClick( nil );
    except
    end;
end;

procedure TFormaSerial.ClrInMemoClick(Sender: TObject);
begin
  RxMemo.Lines.Clear;
end;

procedure TFormaSerial.ClrOutMemoClick(Sender: TObject);
begin
  TxMemo.Lines.Clear;
end;

procedure TFormaSerial.SetDTRBtnClick(Sender: TObject);
begin
  CommPortDriver.ToggleDTR( true );
end;

procedure TFormaSerial.ClrDTRBtnClick(Sender: TObject);
begin
  CommPortDriver.ToggleDTR( false );
end;

procedure TFormaSerial.SetRTSBtnClick(Sender: TObject);
begin
  CommPortDriver.ToggleRTS( true );
end;

procedure TFormaSerial.ClrRTSBtnClick(Sender: TObject);
begin
  CommPortDriver.ToggleRTS( false );
end;

procedure TFormaSerial.CommPortDriverReceiveData(Sender: TObject;
  DataPtr: Pointer; DataSize: Integer);
var p: pchar;
    s: string;
    i:integer;
begin

//MessageBeep( 0 );
//showMessage('leyendo');
//  CommPortDriver.PausePolling;
  s := '     ';
//  CommPortDriver.
//  CommPortDriver.ReadData( @s[1], 5 );
  // Get current line
  if RxMemo.Lines.Count <> 0 then
    s := RxMemo.Lines[RxMemo.Lines.Count-1]
  else
    s := '';
  // Parse incoming text
  p := DataPtr;
  while DataSize > 0 do
  begin
    case p^ of
      #10:; // LF
      #13: // CR - cursor to next line
        begin
          if RxMemo.Lines.Count <> 0 then
            RxMemo.Lines[RxMemo.Lines.Count-1] := s
          else
          begin
              RxMemo.Lines.Clear;
            RxMemo.Lines.Add( s );
            AgregaCadena(s);
          end;
            //ShowMessage('1');
          RxMemo.Lines.Add( '' );
           for i:=1 to length(s) do
    begin
        TecleaTecla(Ord(s[i]));
    end;
          s := '';
        end;
      #8: // Backspace - delete last char
        delete( s, length(s), 1 );
      else // Any other char - add it to the current line
        s := s + p^;
    end;
    dec( DataSize );
    inc( p );
  end;

//ShowMessage(s);
  // If current line isn't empty
  if (s<>'') then
  begin
    if RxMemo.Lines.Count <> 0 then
      // Update current line
      RxMemo.Lines[RxMemo.Lines.Count-1] := s
    else
    begin
      // New line - add it
      RxMemo.Lines.Clear;
      RxMemo.Lines.Add( s );
    AgregaCadena(s);


    end;
//  ShowMessage(s);
  end;
//      ShowMessage('2');
  RxMemo.Update;
//  CommPortDriver.ContinuePolling;


end;

procedure TFormaSerial.CommPortDriverReceivePacket(Sender: TObject;
  Packet: Pointer; DataSize: Integer);
var p: pchar;
    s: string;
begin
    RxMemo.Lines.Clear;
  RXMemo.Lines.Add( 'Packet size = ' + IntToStr( DataSize ) );
  RXMemo.Lines.Add( 'Packet contents:' );
  RXMemo.Lines.Add( '' );
  if RxMemo.Lines.Count <> 0 then
    s := RxMemo.Lines[RxMemo.Lines.Count-1]
  else
    s := '';
  // Parse incoming text
  p := Packet;
  while DataSize > 0 do
  begin
    case p^ of
      #10:; // LF
      #13: // CR - cursor to next line
        begin
          if RxMemo.Lines.Count <> 0 then
            RxMemo.Lines[RxMemo.Lines.Count-1] := s
          else
          begin
           RxMemo.Lines.Clear;
            RxMemo.Lines.Add( s );
          end;
//            ShowMessage('3');
          RxMemo.Lines.Add( '' );
          s := '';
        end;
      #8: // Backspace - delete last char
        delete( s, length(s), 1 );
      else // Any other char - add it to the current line
        s := s + p^;
    end;
    dec( DataSize );
    inc( p );
  end;
  // If current line isn't empty
  if (s<>'') then
    if RxMemo.Lines.Count <> 0 then
      // Update current line
      RxMemo.Lines[RxMemo.Lines.Count-1] := s
    else
    begin
       RxMemo.Lines.Clear;
      // New line - add it
      RxMemo.Lines.Add( s );
    end;  
//      ShowMessage('4');

  RXMemo.Lines.Add( StringOfChar( '*', 80 ) );
  RXMemo.Lines.Add( '' );
  RxMemo.Update;
end;




procedure TFormaSerial.RxMemoChange(Sender: TObject);
begin
{
//ShowMessage(RxMemo.Lines[RxMemo.Lines.Count-1]);
if (RxMemo.Lines[RxMemo.Lines.Count-1]<>'')and(length(RxMemo.Lines[RxMemo.Lines.Count-1])>4)then
begin
  FormaCapturaRapida.EditClave.Text:='';
  FormaCapturaRapida.EditClave.Text:=RxMemo.Lines[RxMemo.Lines.Count-1];
  TecleaTecla(13);
//  TecleaTecla(13);
 FormaCapturaRapida.EditClave.SelectAll;
// FormaCapturaRapida.EditCantidad.SetFocus;
// FormaCapturaRapida.EditClave.SetFocus;
end;
//
//AgregaCadena(RxMemo.Lines[RxMemo.Lines.Count-1]);

//RxMemo.Clear;
}
end;

end.