CD Actual 13/CDA13.ISO/cdactual/demobin/share/program/Pascal/ANSIDRVR.ZIP/DEMOCOM.PAS

Pascal/Delphi Source File | 1992-05-03 | 4.6 KB | 254 lines

{
Turbo Pascal ANSI Drivers
Version 1.12
Copyright (c) 1990 by Not So Serious Software

Original concept by Ian Silver
Design and implementation by Kevin Dean

Kevin Dean
Fairview Mall P.O. Box 55074
1800 Sheppard Avenue East
Willowdale, Ontario
CANADA    M2J 5B9
CompuServe ID: 76336,3114
}


{ This program demonstrates simple text I/O using the ANSICOM communications unit }
program DemoCOM;


uses
  ANSI, ANSICOM;


var
  Result : integer;
  Name : string[20];
  BoxColor, DataColor, BkgndColor : byte;


{***}
procedure UpdateCursorPos;

var
  CurX, CurY, OldAttr : byte;

begin
CurX := WhereX;
CurY := WhereY;
OldAttr := TextAttr;

TextAttr := DataColor;
GotoXY(50, 13);
Write('(', CurX : 2, ',', CurY : 2, ')');

TextAttr := OldAttr;
GotoXY(CurX, CurY)
end;


{***}
procedure DrawBox;

var
  I : byte;

begin
TextAttr := BoxColor;

GotoXY(23, 9);
UpdateCursorPos;
Write('╔');

for I := 24 to 57 do
  begin
  UpdateCursorPos;
  Write('═')
  end;

UpdateCursorPos;
Write('╗');

for I := 10 to 15 do
  begin
  GotoXY(58, I);
  UpdateCursorPos;
  Write('║')
  end;

GotoXY(58, 16);
UpdateCursorPos;
Write('╝');

for I := 57 downto 24 do
  begin
  GotoXY(I, 16);
  UpdateCursorPos;
  Write('═')
  end;

GotoXY(23, 16);
UpdateCursorPos;
Write('╚');

for I := 15 downto 10 do
  begin
  GotoXY(23, I);
  UpdateCursorPos;
  Write('║')
  end
end;


{***}
procedure RunDemo;

begin
Randomize;

repeat
  BoxColor := Random(256);

  DrawBox;

  DataColor := Random(256);
  BkgndColor := Random(256);

  TextAttr := BkgndColor;
  GotoXY(24, 10);
  UpdateCursorPos;
  Write(' Your name:                       ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(36, 10);
  UpdateCursorPos;
  Write(Name);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 11);
  UpdateCursorPos;
  Write(' Box color:       Data color:     ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(36, 11);
  UpdateCursorPos;
  Write(BoxColor : 3);
  UpdateCursorPos;
  GotoXY(54, 11);
  UpdateCursorPos;
  Write(DataColor : 3);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 12);
  UpdateCursorPos;
  Write(' Background color:                ');
  UpdateCursorPos;

  TextAttr := DataColor;
  GotoXY(43, 12);
  UpdateCursorPos;
  Write(BkgndColor : 3);
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 13);
  UpdateCursorPos;
  Write(' Current cursor position:         ');
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 14);
  UpdateCursorPos;
  Write('                                  ');
  UpdateCursorPos;

  TextAttr := BkgndColor;
  GotoXY(24, 15);
  UpdateCursorPos;
  Write(' Press any key to end demo.       ');
  UpdateCursorPos;

  Delay(250)
until KeyPressed
end;


{$F+}

{***}
{ Modem error handler - MUST BE COMPILED AS A FAR PROCEDURE }
procedure ModemError(var Error : word);

var
  ConF : text;

begin
{ Console is taken over by the communications routines so have to reopen it }
Assign(ConF, 'CON');
Rewrite(ConF);

if Error and ReceiveOverrun <> 0 then
  WriteLn(ConF, 'Error : Receive overrun');

if Error and TransmitOverrun <> 0 then
  WriteLn(ConF, 'Error : Transmit overrun');

if Error and ParityError <> 0 then
  WriteLn(ConF, 'Error : Parity error');

if Error and FramingError <> 0 then
  WriteLn(ConF, 'Error : Framing error');

if Error and BreakDetect <> 0 then
  WriteLn(ConF, 'Error : Break detect');

if Error and CommTimeOut <> 0 then
  WriteLn(ConF, 'Error : Modem time out');

if Error and NoCarrier <> 0 then
  WriteLn(ConF, 'Error : No carrier');

if Error and CtrlBreak <> 0 then
  WriteLn(ConF, 'Error : Ctrl-Break');

if Error and NotOnline <> 0 then
  WriteLn(ConF, 'Error : Not on-line');

Close(ConF);

Disconnect;
ReleaseCOM;
halt(1)
end;

{$F-}


{***}
begin
Result := InitCOM(4, 9600, 8, 'N', 1, Init, SyncTransmit, @ModemError);

{ It is very important to make an explicit call to either GotoXY or ClrScr at }
{ the start of your program.  If you do not do so, the internal cursor        }
{ position management will be unpredictable.                                  }
ClrScr;

WriteLn('This program demonstrates simple I/O using the ANSI and ANSI');
WriteLn('communications units.  Among the features demonstrated are screen');
WriteLn('control, cursor control, text attribute control, input and output,');
WriteLn('and the delay counter.');
WriteLn;
Write('What is your name (maximum 20 characters)? ');
ReadLn(Name);

RunDemo;

{ ALWAYS MAKE SURE THAT YOU RELEASE THE COMMUNICATIONS PORT BEFORE EXITING }
ReleaseCOM
end.