unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Spin, Mask, ToolEdit,
  Port;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    btnClose: TBitBtn;
    ReadTimer: TTimer;
    ParamPanel: TPanel;
    rgPortIndex: TRadioGroup;
    btnInit: TButton;
    rgDataLen: TRadioGroup;
    rgStopBits: TRadioGroup;
    rgEnableOdd: TRadioGroup;
    rgBaud: TRadioGroup;
    rgModeOdd: TRadioGroup;
    eOtherBaud: TEdit;
    GroupBox1: TGroupBox;
    bRead: TSpeedButton;
    Panel3: TPanel;
    Bevel2: TBevel;
    DR: TShape;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label8: TLabel;
    Label11: TLabel;
    OE: TShape;
    PE: TShape;
    FE: TShape;
    BD: TShape;
    DCD: TShape;
    RI: TShape;
    CTS: TShape;
    DSR: TShape;
    TERI: TShape;
    Label12: TLabel;
    eReadBuffer: TEdit;
    btnClearReadBuf: TSpeedButton;
    GroupBox2: TGroupBox;
    btnSend: TSpeedButton;
    seSendByte: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure rgBaudClick(Sender: TObject);
    procedure bReadClick(Sender: TObject);
    procedure ReadTimerTimer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnInitClick(Sender: TObject);
    procedure rgPortIndexClick(Sender: TObject);
    procedure rgPortPropChange(Sender: TObject);
    procedure eOtherBaudKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnClearReadBufClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Компонент для доступа к порту. Будем создавать его}
    { динамически.																			}
    FPort : TPort;
    { базовый адрес порта }
    BaseCOM : Word;
  public
    procedure ReadCOMParam;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ Создание компонента доступа к портам при создании формы }
procedure TForm1.FormCreate(Sender: TObject);
begin
 FPort:= TPort.Create(Self);
end;

{Вызывается при уничтожении формы (выходе из программы) }
procedure TForm1.FormDestroy(Sender: TObject);
begin
 FPort.Free;
end;

{первое чтение}
procedure TForm1.FormActivate(Sender: TObject);
begin
 rgPortIndexClick(nil);
end;

{Инициализация порта }
procedure TForm1.btnInitClick(Sender: TObject);
Var B : Byte; Speed, Freq : Word;  
begin
 Try
  {Блокируем повторное нажатие кнопки или }
  {изменение параметров, пока не установим}
  {текущие параметры 											}
  ParamPanel.Enabled:= False;
  ReadTimer.Enabled := False;

  {Вычисляем и программируем делитель скорости}
  If (rgBaud.ItemIndex = (rgBaud.Items.Count-1)) then
   Speed:= StrToIntDef(eOtherBaud.Text, 0) {скорость обмена не из списка}
  Else {скорость обмена из списка}
   Speed:= StrToIntDef(rgBaud.Items[rgBaud.ItemIndex], 0);

  If Speed = 0 then begin
   MessageDlg('Плохое значение скорости обмена!', mtError, [mbOK], 0);
   Exit;
  End;

  {Устанавливаем бит DLAB для программирования делителя}
  FPort[BaseCOM+3]:= FPort[BaseCOM+3] or $80;
  {Вычисляем делитель}
  Freq:= 115200 div Speed;
  {Программируем делитель}
  FPort[BaseCOM+0]:= Lo(Freq);
  FPort[BaseCOM+1]:= Hi(Freq);
  {Сбрасываем бит DLAB}
  FPort[BaseCOM+3]:= FPort[BaseCOM+3] and $7F;

  B:= 0;
  Case rgModeOdd.ItemIndex of
   0: // нечет
    B:= B or $00;
   1: // чет
    B:= B or $10;
   2: // постоянная 1
    B:= B or $20;
   3: // постоянный 0
    B:= B or $30;
  End;

  Case rgEnableOdd.ItemIndex of
   0: // контроль четности запрещен
    B:= B or $00;
   1: // контроль четности включен
    B:= B or $08;
  End;

  Case rgStopBits.ItemIndex of
   0: // 1 стоп-бит
    B:= B or $00;
   1: // 2 (1.5) стоп-бита
    B:= B or $04;
  End;

  Case rgDataLen.ItemIndex of
   0: // 5 бит
    B:= B or $00;
   1: // 6 бит
    B:= B or $01;
   2: // 7 бит
    B:= B or $02;
   3: // 8 бит
    B:= B or $03;
  End;

  {установить новые характеристики порта}
  FPort[BaseCOM+3]:= B;
 Finally
  ParamPanel.Enabled:= True;
  ReadTimer.Enabled := bRead.Down;
 End;

 {Перечитать настройки порта}
 ReadCOMParam;
end;

{Перечитать настройки порта при выборе порта}
procedure TForm1.rgPortIndexClick(Sender: TObject);
begin
 {Базовый адрес порта}
 Case rgPortIndex.ItemIndex of
  0: BaseCOM:= $3F8;
  1: BaseCOM:= $2F8;
 End;
 ReadCOMParam;
end;

{Чтение текущих настроек порта}
procedure TForm1.ReadCOMParam;
Var B : Byte; Speed, Freq : Word; FreqL, FreqH : Byte;
    i : Integer;
begin
 Try
  {Блокируем изменение параметров на время чтения настроек}
  ParamPanel.Enabled:= False;
  ReadTimer.Enabled := False;

  {Устанавливаем бит DLAB для чтения делителя}
  FPort[BaseCOM+3]:= FPort[BaseCOM+3] or $80;
  FreqL:= FPort[BaseCOM+0];
  FreqH:= FPort[BaseCOM+1];
  {Сбрасываем бит DLAB }
  FPort[BaseCOM+3]:= FPort[BaseCOM+3] and $7F;

  {Вычисляем делитель}
  Freq:= FreqH shr 8 + FreqL;

  {Вычисляем скорость обмена}
  If Freq > 0 then Speed:= 115200 div Freq else Speed:= 0;

  {Проверяем наличие такой скорости в таблице}
  i:= rgBaud.Items.IndexOf(IntToStr(Speed));
  If i < 0 then begin {В таблице не нашли - пишем "другая"}
   rgBaud.ItemIndex:= rgBaud.Items.Count-1;
   eOtherBaud.Text := IntToStr(Speed);
   eOtherBaud.Visible:= True;
  End Else begin
   rgBaud.ItemIndex:= i;
   eOtherBaud.Visible:= False;
  End;

  B:= FPort[BaseCOM+3]; {характеристики порта}

  Case (B and $30) of
   $00: // нечет
    rgModeOdd.ItemIndex:= 0;
   $10: // чет
    rgModeOdd.ItemIndex:= 1;
   $20: // постоянная 1
    rgModeOdd.ItemIndex:= 2;
   $30: // постоянный 0
    rgModeOdd.ItemIndex:= 3;
  End;

  Case (B and $08) of
   $00: // контроль четности запрещен
    rgEnableOdd.ItemIndex:= 0;
   $08: // контроль четности включен
    rgEnableOdd.ItemIndex:= 1;
  End;

  Case (B and $04) of
   $00: // 1 стоп-бит
    rgStopBits.ItemIndex:= 0;
   $04: // 2 (1.5) стоп-бита
    rgStopBits.ItemIndex:= 1;
  End;

  Case (B and $03) of
   $00: // 5 бит
    rgDataLen.ItemIndex:= 0;
   $01: // 6 бит
    rgDataLen.ItemIndex:= 1;
   $02: // 7 бит
    rgDataLen.ItemIndex:= 2;
   $03: // 8 бит
    rgDataLen.ItemIndex:= 3;
  End;
 Finally
  ParamPanel.Enabled:= True;
  ReadTimer.Enabled := bRead.Down;
 End;
End;

{Кнопка закрытия программы}
procedure TForm1.btnCloseClick(Sender: TObject);
begin
 Close;
end;

procedure TForm1.rgBaudClick(Sender: TObject);
begin
 {Видимость окошка "Другая скорость"}
 eOtherBaud.Visible:=
   (rgBaud.ItemIndex = (rgBaud.Items.Count-1));
 {Изменение характеристик порта}
 rgPortPropChange(nil);
end;

procedure TForm1.eOtherBaudKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 {Изменение скорости обмена по клавише Enter}
 If Key = 13 then rgPortPropChange(nil);
end;

{Любое изменение характеристик порта}
procedure TForm1.rgPortPropChange(Sender: TObject);
begin
 {Инициализация при изменении свойств порта}
 btnInitClick(nil);
end;

{Кнопка опроса порта}
procedure TForm1.bReadClick(Sender: TObject);
begin
 ReadTimer.Enabled:= bRead.Down;
end;

Const {Цвета индикаторов}
 IColor : Array [Boolean] of TColor = (clWhite, clGreen);

procedure TForm1.ReadTimerTimer(Sender: TObject);
Var B, B1, B2 : Byte; S : String; 
begin
 {Состояние модема и порта считываем до чтения байта,}
 {так как после чтения данных с порта состояние порта}
 {изменится.}
 B1:= FPort[BaseCOM+5]; {Байт состояния порта}
 B2:= FPort[BaseCOM+6]; {Байт состояния модема}

 {Проверка наличия данных и их отображение}
 If (B1 and $01) <> 0 then begin {Бит "есть данные для чтения"}
  B:= FPort[BaseCOM+0]; { принятый байт }
  S:= eReadBuffer.Text;
  S:= S + Format('$%X',[B]);
  If Length(S) > 50 then Delete(S, 1, 3);
  eReadBuffer.Text:= S;
 End;

 {Отображение индикаторов состояния порта}
 {Сигнал DR (данные готовы)}
 DR.Brush.Color:= IColor[(B1 and $01) <> 0];
 {Сигнал OE (переполнение)}
 OE.Brush.Color:= IColor[(B1 and $02) <> 0];
 {Ошибка паритета}
 PE.Brush.Color:= IColor[(B1 and $04) <> 0];
 {Ошибка кадра (неверный стоп-бит)}
 FE.Brush.Color:= IColor[(B1 and $08) <> 0];
 {Индикатор обрыва линии}
 BD.Brush.Color:= IColor[(B1 and $10) <> 0];

 {Отображение индикаторов состояния модема}
 {Состояние линии DCD (data carrier detect)}
 DCD.Brush.Color := IColor[(B2 and $80) <> 0];
 {Состояние линии RI (ring indicator)}
 RI .Brush.Color := IColor[(B2 and $40) <> 0];
 {Состояние линии DSR (data set ready)}
 DSR.Brush.Color := IColor[(B2 and $20) <> 0];
 {Состояние линии CTS (clear to send)}
 CTS.Brush.Color := IColor[(B2 and $10) <> 0];
 {Сигнал "спад огибающей" (окончание звонка)}
 TERI.Brush.Color:= IColor[(B2 and $04) <> 0];
end;

{Очистить буфер чтения}
procedure TForm1.btnClearReadBufClick(Sender: TObject);
begin
 eReadBuffer.Text:= '';
end;

{Отправка байта}
procedure TForm1.btnSendClick(Sender: TObject);
begin
 FPort[BaseCOM]:= seSendByte.Value;
end;

end.
