serialngadvdemomain.pas

RS232 Source using delphi

unit SerialNGAdvDemoMain;
{
Hello folks,
this is the advanced Demo for the SerialPortNG Component.
Nearly everthing what is possible with the Component is shown here:
- Configuration of the Port (Advanced)
- Sending and receiving Data
- Reading the several Inputlines
- Setting the DTR and RTS line and the Break State
- Do some work on Events
In this example I show the usage  of OnCommEvent
This catches all the different Events (CTS, DSR, LineError, Ring, RLSD, RxChar, RxEventChar),
on one Job.
You may decide to pick a single Event, e.g. the OnRxEventChar to do a special work

You may want to build a Testadapter.
Simply buy (or find in Your home) a standard
9 Pin Sub-D Male Plug (if Your desired Port has 25 Pins use a 25 Pin Plug :-))
and sold bridges as follow (in Brackets 25 Pin version)
Pin 2 with Pin 3 (same for 25 Pin)
Pin 4 with Pin 6 (Pin 6 with Pin 20)
Pin 7 with Pin 8 (Pin 4 with Pin 5)
Additionally You may also use a simple Comporttester (has some blinking lights)
*No warranty* for Your Hardware!!!
Some People say that pluging on the serial Port should be done only if the
computer is in "Off"-State. I played allways in "On"-State and I killed never
a Commport.
For US Users only:
Dont store the Cat in the Microwavestove, until You *really* know what are You doing ;-)
Already plugged You should see that both lights on the Program (DSR+DTR, and RTS+CTS)
are in the same state. Toggling the corresponded CheckBoxes should toggle both lights.
}

interface

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

type
  TForm1 = class(TForm)
    SerialPortNG1: TSerialPortNG;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Terminal: TMemo;
    CBAddCRLF: TCheckBox;
    SendEdit: TEdit;
    Label1: TLabel;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    AdvSettingsBtn: TButton;
    LedImageList: TImageList;
    PortImage: TImage;
    CTSImage: TImage;
    DCDImage: TImage;
    RTSImage: TImage;
    DSRImage: TImage;
    RIImage: TImage;
    DTRImage: TImage;
    TxDImage: TImage;
    RxDImage: TImage;
    BreakImage: TImage;
    CBDTR: TCheckBox;
    CBRTS: TCheckBox;
    CBBreakState: TCheckBox;
    Timer1: TTimer;
    ErrorMemo: TMemo;
    Label2: TLabel;
    MaxErrorEdit: TEdit;
    SendBtn: TButton;
    TabSheet4: TTabSheet;
    Memo1: TMemo;
    SaveSettingsBtn: TButton;
    LoadSettingsBtn: TButton;
    CTSHoldImage: TImage;
    DSRHoldImage: TImage;
    RLSHoldImage: TImage;
    XOffHoldImage: TImage;
    XOnSendImage: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    CBRecordErrors: TCheckBox;
    Bevel1: TBevel;
    ProgressTxDQueue: TProgressBar;
    ProgressRxDQueue: TProgressBar;
    Label8: TLabel;
    Label9: TLabel;
    procedure AdvSettingsBtnClick(Sender: TObject);
    procedure SerialPortNG1RxClusterEvent(Sender: TObject);
    procedure SendBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SerialPortNG1RxCharEvent(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SerialPortNG1TxQueueEmptyEvent(Sender: TObject);
    procedure SerialPortNG1ProcessError(Sender: TObject; Place,
      Code: DWord; Msg: String);
    procedure CBDTRClick(Sender: TObject);
    procedure CBRTSClick(Sender: TObject);
    procedure CBBreakStateClick(Sender: TObject);
    procedure SaveSettingsBtnClick(Sender: TObject);
    procedure LoadSettingsBtnClick(Sender: TObject);
    procedure SerialPortNG1CommEvent(Sender: TObject);
    procedure SerialPortNG1CommStat(Sender: TObject);
    procedure SerialPortNG1WriteDone(Sender: TObject);
  private
    { Private declarations }
    RxDCharStartTimer : Boolean;
    RxDCharResetTimer : Boolean;
    SendDataSize : DWord;
    procedure SetLeds;
    procedure ResetLeds;
    procedure RepaintLeds;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
const
  LedGray = 0;
  LedRedOff = 1;
  LedRedOn = 2;
  LedGreenOff = 3;
  LedGreenOn = 4;
  LedYellowOff = 5;
  LedYellowOn = 6;

implementation

uses SerialNGAdv; // Include Advanced Dialog


{$R *.DFM}
procedure AddHexString(S : String; Lines : TStrings );
var AddS, HexS, CopyS : String;
    i : Integer;
const SLen = 8;
begin
  while Length(S) > 0 do
    begin
      AddS := Copy(S,1,SLen);
      HexS := '';
      Delete(S,1,SLen);
      for i := 1 to SLen do
        begin
          CopyS := Copy(AddS,i,1);
          if CopyS <> '' then
            HexS := HexS + ' ' + Format('%2.2x',[Byte(CopyS[1])]) //
          else
            HexS := HexS + '   ';
        end;
       while Length(AddS) < SLen do
         AddS := AddS + ' ';
       for i := 1 to SLen do
         case AddS[i] of
           #0..#31 : AddS[i] := '.';
           #127    : AddS[i] := '.';
         end;
       Lines.Add(HexS+' : '+AddS);
    end;
end;

procedure TForm1.AdvSettingsBtnClick(Sender: TObject);
begin
  SerialNGAdvDLG.SetDLGData(SerialPortNG1);
  if SerialNGAdvDLG.ShowModal = mrOK then
    SerialNGAdvDLG.GetDLGData(SerialPortNG1);
  if SerialPortNG1.Active then
    SetLeds
  else
    ResetLeds;
end;

// All receiving is done here
// See how less Lines!
procedure TForm1.SerialPortNG1RxClusterEvent(Sender: TObject);
begin
  if SerialPortNG1.NextClusterSize >= 0 then // Data available?
    begin
      if SerialPortNG1.NextClusterCCError = 0 then // Error during receiveing?
        Terminal.Lines.Add(FormatDateTime('"Rec  " dd.mm.yy hh:mm:ss" :"', Now))
      else
        Terminal.Lines.Add(FormatDateTime('"RecX " dd.mm.yy hh:mm:ss" :"', Now));
      // Read the data and patch them into the editfield
      AddHexString(SerialPortNG1.ReadNextClusterAsString,Terminal.Lines);
    end;

end;

// All sending is done here
procedure TForm1.SendBtnClick(Sender: TObject);
var SendStr : String;
begin
  if Length(SendEdit.Text) > 0 then
    begin
      Terminal.Lines.Add(FormatDateTime('"Snd " dd.mm.yy hh:mm:ss" :"', Now));
      Terminal.Lines.Add(SendEdit.Text);
      SendStr := SendEdit.Text;
      if CBAddCRLF.Checked then
        SendStr := SendStr+#$0d#$0a;
      SendDataSize := Length(SendStr);
      SendBtn.Enabled := False;
      SerialPortNG1.SendString(SendStr); // Send the String: Thats really all
      LedImageList.GetBitmap(LedGreenOn,TxDImage.Picture.Bitmap);
      TxDImage.Repaint;
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SerialPortNG1.Active := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ResetLeds;
  SerialPortNG1.Active := True;
  if SerialPortNG1.Active then
    begin
      SetLeds;
      ProgressTxDQueue.Min := 0;
      ProgressTxDQueue.Max := SerialPortNG1.TxQueueSize;
      ProgressTxDQueue.Position := 0;
      ProgressRxDQueue.Min := 0;
      ProgressRxDQueue.Max := SerialPortNG1.RxQueueSize;
      ProgressRxDQueue.Position := 0;
    end;
  RxDCharStartTimer := False;
  RxDCharResetTimer := False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  SerialPortNG1.Active := False;
end;

procedure TForm1.SerialPortNG1RxCharEvent(Sender: TObject);
begin
  LedImageList.GetBitmap(LedGreenOn,RxDImage.Picture.Bitmap);
  RxDImage.Repaint;
  RxDCharStartTimer := True;
  RxDCharResetTimer := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if RxDCharResetTimer then // Second Step: Rest Led now
    begin
      LedImageList.GetBitmap(LedGreenOff,RxDImage.Picture.Bitmap);
      RxDImage.Repaint;
      RxDCharStartTimer := False;
      RxDCharResetTimer := False;
    end;
  if RxDCharStartTimer then // First Step: Led is On
    RxDCharResetTimer := True; // Reset the Led in the next Timer Event
end;

procedure TForm1.SerialPortNG1TxQueueEmptyEvent(Sender: TObject);
begin
  LedImageList.GetBitmap(LedGreenOff,TxDImage.Picture.Bitmap);
  TxDImage.Repaint;
end;

procedure TForm1.SerialPortNG1ProcessError(Sender: TObject; Place,
  Code: DWord; Msg: String);
var MaxError : Integer;
begin
  if CBRecordErrors.Checked then
    begin
      MaxError := StrToIntDef(MaxErrorEdit.Text,256);
      while ErrorMemo.Lines.Count > MaxError do
        ErrorMemo.Lines.Delete(0);
      ErrorMemo.Lines.Add(FormatDateTime('"Msg  " dd.mm.yy hh:mm:ss" :"', Now)+Format('Code %d at %d Text: %s',[Code,Place,Msg]));
    end;
end;

procedure TForm1.SetLeds;
begin
  if SerialPortNG1.BREAKState then
    begin
      CBBreakState.Checked := True;
      LedImageList.GetBitmap(LedRedOn,BreakImage.Picture.Bitmap);
    end
  else
    begin
      CBBreakState.Checked := False;
      LedImageList.GetBitmap(LedGreenOn,BreakImage.Picture.Bitmap);
    end;
  if SerialPortNG1.CTSState then
    LedImageList.GetBitmap(LedRedOn,CTSImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,CTSImage.Picture.Bitmap);
  if SerialPortNG1.DSRState then
    LedImageList.GetBitmap(LedRedOn,DSRImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,DSRImage.Picture.Bitmap);
  if SerialPortNG1.RingState then
    LedImageList.GetBitmap(LedRedOn,RIImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,RIImage.Picture.Bitmap);
  if SerialPortNG1.RLSDState then
    LedImageList.GetBitmap(LedRedOn,DCDImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,DCDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOff,RxDImage.Picture.Bitmap);
  if CBDTR.Checked then
    LedImageList.GetBitmap(LedRedOn,DTRImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,DTRImage.Picture.Bitmap);
  if CBRTS.Checked then
    LedImageList.GetBitmap(LedRedOn,RTSImage.Picture.Bitmap)
  else
    LedImageList.GetBitmap(LedGreenOn,RTSImage.Picture.Bitmap);
  RepaintLeds;
end;

procedure TForm1.ResetLeds;
begin
  LedImageList.GetBitmap(LedGray,CTSImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,RTSImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,DSRImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,RIImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,DTRImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,TxDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOff,RxDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,DCDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGray,BreakImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOff,RxDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOff,TxDImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOn,CTSHoldImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOn,DSRHoldImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOn,RLSHoldImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOn,XOffHoldImage.Picture.Bitmap);
  LedImageList.GetBitmap(LedGreenOn,XOnSendImage.Picture.Bitmap);
  RepaintLeds;
end;


procedure TForm1.CBDTRClick(Sender: TObject);
begin
  SerialPortNG1.DTRState := CBDTR.Checked;
  SetLeds;
end;

procedure TForm1.CBRTSClick(Sender: TObject);
begin
  SerialPortNG1.RTSState := CBRTS.Checked;
  SetLeds;
end;

procedure TForm1.CBBreakStateClick(Sender: TObject);
begin
  SerialPortNG1.BREAKState := CBBreakState.Checked;
  SetLeds;
end;

procedure TForm1.SaveSettingsBtnClick(Sender: TObject);
begin
  SerialPortNG1.WriteSettings('Software\DomIS','SerialNGAdvDemo');
end;

procedure TForm1.LoadSettingsBtnClick(Sender: TObject);
begin
  SerialPortNG1.ReadSettings('Software\DomIS','SerialNGAdvDemo');
end;

procedure TForm1.SerialPortNG1CommEvent(Sender: TObject);
begin
  SetLeds;
end;

procedure TForm1.SerialPortNG1CommStat(Sender: TObject);
var s: String;
begin
  s := '';
  if fCtlHold in SerialPortNG1.CommStateFlags then
    begin
      LedImageList.GetBitmap(LedRedOn,CTSHoldImage.Picture.Bitmap);
      s := s + 'Transmission is waiting for the CTS (clear-to-send) signal to be sent.'+#$0d#$0a;
    end
  else
    LedImageList.GetBitmap(LedGreenOn,CTSHoldImage.Picture.Bitmap);
  if fDsrHold in SerialPortNG1.CommStateFlags then
    begin
      LedImageList.GetBitmap(LedRedOn,DSRHoldImage.Picture.Bitmap);
      s := s + 'Transmission is waiting for the DSR (data-set-ready) signal to be sent.'+#$0d#$0a;
    end
  else
    LedImageList.GetBitmap(LedGreenOn,DSRHoldImage.Picture.Bitmap);
  if fRlsHold in SerialPortNG1.CommStateFlags then
    begin
      LedImageList.GetBitmap(LedRedOn,RLSHoldImage.Picture.Bitmap);
      s := s + 'Transmission is waiting for the RLSD (receive-line-signal-detect) signal.'+#$0d#$0a;
    end
  else
    LedImageList.GetBitmap(LedGreenOn,RLSHoldImage.Picture.Bitmap);
  if fXoffHold in SerialPortNG1.CommStateFlags then
    begin
      LedImageList.GetBitmap(LedRedOn,XOffHoldImage.Picture.Bitmap);
      s := s + 'Transmission is waiting because the XOFF character was received.'+#$0d#$0a;
    end
  else
    LedImageList.GetBitmap(LedGreenOn,XOffHoldImage.Picture.Bitmap);
  if fXoffSent in SerialPortNG1.CommStateFlags then
    begin
      LedImageList.GetBitmap(LedRedOn,XOnSendImage.Picture.Bitmap);
      s := s + 'Transmission is waiting because the XOFF character was transmitted.'+#$0d#$0a;
    end
  else
    LedImageList.GetBitmap(LedGreenOn,XOnSendImage.Picture.Bitmap);
  if fEof in SerialPortNG1.CommStateFlags then
    s := s + 'The end-of-file (EOF) character has been received.'+#$0d#$0a;
  if fTxim in SerialPortNG1.CommStateFlags then
    s := s + 'There is a character queued for transmission that has come to the communications device by way of the TransmitCommChar function.'+#$0d#$0a;
  if s <> '' then
    SerialPortNG1ProcessError(Self, 0000, 0, s);
  ProgressTxDQueue.Position := SerialPortNg1.CommStateOutQueue;
  ProgressRxDQueue.Position := SerialPortNg1.CommStateInQueue;
  RepaintLeds;
end;

procedure TForm1.SerialPortNG1WriteDone(Sender: TObject);
begin
  if SerialPortNG1.WrittenBytes <> SendDataSize then
    SerialPortNG1ProcessError(Self, 0001, 0, 'Not all Bytes send');
  SendBtn.Enabled := True;
end;

procedure TForm1.RepaintLeds;
begin
  CTSImage.Repaint;
  DCDImage.Repaint;
  RTSImage.Repaint;
  DSRImage.Repaint;
  RIImage.Repaint;
  DTRImage.Repaint;
  TxDImage.Repaint;
  RxDImage.Repaint;
  BreakImage.Repaint;
  CTSHoldImage.Repaint;
  DSRHoldImage.Repaint;
  RLSHoldImage.Repaint;
  XOffHoldImage.Repaint;
  XOnSendImage.Repaint;
end;

end.