ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/PCTV2N2.ZIP/VTDLG.PAS

Pascal/Delphi Source File | 1990-10-04 | 4.9 KB | 191 lines

unit VTDlg;
{$X+}

Interface
uses ComIO, Drivers, App, Memory, Dialogs, Objects,
  MsgBox, TextView, Views;

type
  TLineSettings = record
    Port, Baud, DataBits, Parity, StopBits: Word;
  end;
  PComWindow = ^TComWindow;
  TComWindow = object(TWindow)
    Terminal: PTerminal;
    LineSettings: TLineSettings;
    LocalEcho: Boolean;
    Win: Text;
    constructor Init;
    destructor Done; virtual;
    procedure HandleEvent(VAR Event: TEvent); virtual;
    Function InitCOM(LineParam: TLineSettings): Boolean;
    procedure SetLocalEcho;
    procedure SetLineDialog;
  end;

procedure ErrorDialog(S: String);

Implementation

procedure ErrorDialog(S: String);
begin
  MessageBox(S, nil, mfOkButton);
end;

constructor TComWindow.Init;
var R: TRect;
begin
  Desktop^.GetExtent(R);
  R.Grow(1,1);
  TWindow.Init(R, 'Turbo Vision Terminal', wnNoNumber);
  Options := (Options xor ofTopSelect) or ofSelectable;
  Flags := Flags xor wfClose;
  GetExtent(R);
  R.Grow(-1,-1);
  Terminal:=New(PTerminal, Init(R,
    StandardScrollBar(sbHorizontal + sbHandleKeyboard),
    StandardScrollBar(sbVertical + sbHandleKeyboard), 8000));
  Insert(Terminal);
  AssignDevice(Win, Terminal);
  ReWrite(Win);
  with LineSettings do
  begin
    Port:=0;     { COM 1 }
    Baud:=2;     { 2400 }
    DataBits:=1; { 8 }
    Parity:=0;   { No Parity }
    StopBits:=0; { No Stops }
  end;
  ComInit(4000);
  InitCOM(LineSettings);
  LocalEcho:=False;
end;

destructor TComWindow.Done;
begin
  ComDone;
  TWindow.Done;
end;

procedure TComWindow.HandleEvent(var Event: TEvent);
begin
  if (Event.What and evKeyDown) <> 0 then
  begin
    if Event.CharCode <> #0 then
      case Event.CharCode of
        #13: begin
          ComPut(13);
          if LocalEcho then Writeln(Win);
          ClearEvent(Event);
        end;
        else begin
          ComPut(Byte(Event.CharCode));
          if LocalEcho then Write(Win, Event.CharCode);
          ClearEvent(Event);
        end;
      end { CASE }
    end;
  TWindow.HandleEvent(Event);
end;

Function TComWindow.InitCOM(LineParam: TLineSettings): Boolean;
const
  BaudArr: array[0..4] of Byte = (Baud300, Baud1200, Baud2400,
    Baud4800, Baud9600);
  DataBitsArr: array[0..1] of Byte = (WordSize7, WordSize8);
  ParityArr: array[0..2] of Byte = (NoParity, EvenParity, OddParity);
  StopBitsArr: array[0..1] of Byte = (StopBits1, StopBits2);
begin
  with LineParam do
  if ComSetParam(Port,
    BaudArr[Baud] or
    DataBitsArr[DataBits] or
    ParityArr[Parity] or
    StopBitsArr[StopBits])
  then InitCOM:=True
  else begin
    InitCOM:=False;
    ErrorDialog('Cannot initialize COM'+char(Ord('1')+Port));
  end;
end;

procedure TComWindow.SetLocalEcho;
begin
  LocalEcho := MessageBox('Local echo needed? ', nil,
    mfYesButton + mfNoButton) = cmYes;
end;

procedure TComWindow.SetLineDialog;
var
  D: PDialog;
  Control: PView;
  R: TRect;
  Help: TLineSettings;
begin
  R.Assign(0,0,37,18);
  D := New(PDialog, Init(R, 'Line Settings'));
  with D^ do
  begin
    Options := Options or ofCentered;
    R.Assign(5, 3, 16, 5);
    Control := New(PRadioButtons, Init(R,
      NewSItem('COM ~1~',
      NewSItem('COM ~2~', nil))));
    Insert(Control);
    R.Assign(4, 2, 11, 3);
    Insert(New(PLabel, Init(R, '~P~ort', Control)));
    R.Assign(5, 7, 16, 12);
    Control := New(PRadioButtons, Init(R,
      NewSItem('300',
      NewSItem('1200',
      NewSItem('2400',
      NewSItem('4800',
      NewSItem('9600', nil)))))));
    Insert(Control);
    R.Assign(4, 6, 11, 7);
    Insert(New(PLabel, Init(R, '~B~aud', Control)));
    R.Assign(22, 3, 32, 5);
    Control := New(PRadioButtons, Init(R,
      NewSItem('~7~',
      NewSItem('~8~', nil))));
    Insert(Control);
    R.Assign(21, 2, 32, 3);
    Insert(New(PLabel, Init(R, '~D~ata Bits', Control)));
    R.Assign(22, 7, 32, 10);
    Control := New(PRadioButtons, Init(R,
      NewSItem('~N~one',
      NewSItem('~E~ven',
      NewSItem('~O~dd', nil)))));
    Insert(Control);
    R.Assign(21, 6, 32, 7);
    Insert(New(PLabel, Init(R, 'P~a~rity', Control)));
    R.Assign(22, 12, 32, 14);
    Control := New(PRadioButtons, Init(R,
      NewSItem('~1~',
      NewSItem('~2~', nil))));
    Insert(Control);
    R.Assign(21, 11, 32, 12);
    Insert(New(PLabel, Init(R, '~S~top Bits', Control)));
    R.Assign(4, 15, 14, 17);
    Insert(New(PButton, Init(R, 'O~k~', cmOK, bfDefault)));
    R.Assign(23, 15, 33, 17);
    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
    SelectNext(False);
  end;
  if LowMemory then
  begin
    Dispose(D, Done);
    ErrorDialog('Out of memory');
    DoneMemory;
  end
  else begin
    D^.SetData(LineSettings);
    if DeskTop^.ExecView(D) = cmOK then
    begin
      D^.GetData(Help);
      if InitCOM(Help) then LineSettings:=Help;
    end;
    Dispose(D, Done);
  end;
end;
end.